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ABSTRACT 

The  design  and  implementation  of  the  N'PS  LISP  1.5  VERS  1  program- 
ming system  is  described.   N'PS  LISP  1.5  VERS  1  is  a  complete  orogram- 
ming  system  built  around  tne  original  implementation  of  LISP  1.5  on  the 
I3M  360/67  computer  at  the  Naval  Postgraduate  School.   The  new  version 
includes  a  Supervisor  and  an  Editor,  as  well  as  the  original  LISP 
Interpreter.    The  VERS  1  system  is  written  in  PL/I  for  time-sharing 
operation  on  the  IBM  360/67  computer. 
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I.   INTRODUCTION 

The  NPS  LISP  1.5  VERS  1  System  is  an  extension  of  NPS  LISP  which 
was  developed  at  the  Naval  Postgraduate  School  by  Lieutenant  Donald  G. 
Gentry,  USN,  and  Ma ior  John  C.  Pilley,  USMC,  and  documented  in  Lieuten- 
ant Gentry's  thesis  [Ref.  1],  dated  December  1969.   The  NPS  LISP  system 
was  an  "on-line  interactive  version  of  LISP  for  the  IBM  360/67  computer'1, 
and  was  written  in  PL/I  to  run  under  the  CP/CMS  time-sharing  system. 
(The  CP/CMS  time-sharing  system  is  described  fully  in  Reference  5.) 

NPS  LISP  1.5  VERS  1  system  consists  of  three  modules. 
These  modules  are: 

1.  the  Supervisor, 

2.  the  Editor, 

3.  the   Interpreter. 

The  Interpreter  module  of  the  extended  system  is  the  original  NPS  LISP 
system  without  its  supervisor.   The  Supervisor  module  is  an  expansion  of 
the  NPS  LISP  supervisor  and  includes  all  the  latter's  functions,  while 
the  Editor  module  is  an  entirely  new  entity,  unique  to  the  VERS  1  system. 

This  thesis  describes  the  expansion  of  NPS  LISP  into  the  system 
named  NPS  LISP  1.5  VERS  1.   The  development  of  those  features  of  the 
expanded  system  which  are  new  or  revised  is  described  in  detail.   It  is 
assumed  that  the  reader  has  access  to  Reference  1,  since  the  description 
of  the  Interpreter  will  not  be  repeated  here.   A  knowledge  of  PL/I  is 
desirable  so  that  the  reader  may  interpret  the  statements  in  the  VERS  1 
listing. 


D.  G.  Gentry,  An  Implementation  of  LIPS  1.5  for  the  IBM  360/67 
Computer  (Monterey,  1969),  p.  9. 


As  has  been  noted,  such  a  supervisor  incorporates  no  housekeeping 
functions.   If  it  were  to  be  expanded  to  include  such  housekeeping  chores 
as  an  editor  and  an  I/O  package,  appropriate  LISP  functions  would  have  to 
be  written  and  incorporated  as  permanently  defined  functions  in  the  LISP 
system.   In  general  this  poses  no  problems.   For  example,  0-32  LISP  [Ref. 
3]  uses  LISP  functions  for  I/O.   The  elaborate  editor  of  BBN  LISP  [Ref. 
4]  also  uses  LISP  functions  for  its  routines.   However,  these  systems  were 
coded  in  their  particular  machine  language,  and  hence  supervisor  functions 
written  in  LISP  were  natural. 

NPS  LISP  was  coded  in  PL/l.   This  was  done  because  PL/I,  being  a 
higher  level  language,  "...provides  major  advantages  over  a  system  writ- 
ten in  machine  code:  (1)  alterations  to  the  system  may  be  easily  made; 

(2)  the  system  may  be  implemented  quite  easily  on  another  computer  having  a 

3 
PL/I  compiler;  and  (3)  the  system  is  self -documenting  to  some  extent." 

Another  important  reason  for  writing  the  supervisor  and  editor  in  PL/I  is 
that  most  of  the  LISP  memory  is  still  available  to  the  user  to  store 
list  structures  and  the  numbers  his  programs  might  generate.   Thus  a  mini- 
mum amount  of  LISP  free  storage  is  taken  up  by  the  "nucleus"  of  permanent 
LISP  functions. 

After  having  decided  to  write  the  expanded  supervisor  (and  editor) 
in  PL/I,  the  next  task  was  to  determine  just  what  capabilities  to  in- 
corporate in  the  expanded  system. 

Much  of  the  motivation  for  features  finally  incorporated  into  the  new 
system  came  from  practical  experience  gained  on  the  terminal  with  the 
CP/CMS  time-sharing  system.   This  motivation,  as  well  as  other  influences 
is  discussed  in  the  sections  that  follow. 


3 
Gentry,  p.  50. 
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II.   THE  SUPERVISOR 

A.    A  GENERAL  DISCUSSION  OF  LISP  SUPERVISORS 

The  supervisor  of  any  LISP  system  must  perform  certain  basic  func- 
tions.  First,  it  must  read  in  a  functional  expression  (S-expression) 
and  its  arguments  (also  an  S-expression).   Second,  it  must  apply  the 
function  to  the  arguments  to  obtain  a  value,  and,  third,  it  must  print 
that  value.   The  basic  LISP  supervisor  is  a  routine  which  loops  continu- 
ously, while  LISP  is  active,  performing  these  functions.   Disregarding 
any  system  "housekeeping"  needs,  this  basic  supervisor  meets  the  minimum 
requirements  of  a  LISP  system. 

The  NPS  supervisor  was  essentially  identical  to  tne  supervisor  des- 
cribed above.   It  looped  continuously  until  detecting  an  *END  LISP'  input, 
which  caused  it  to  terminate.   The  NPS  LISP  supervisor  was  a  routine 
written  in  PL/l,  though,  in  general,  a  LISP  supervisor  is  a  LISP  func- 
tion called  EVALQUOTE.   An  example  of  a  LISP  1.5  coding  of  EVALQUOTE  follows 
which  is  taken  from  Weissman  [Ref.  2].   The  variables  SI  and  S2  are  the  two 
S-expressions  that  the  supervisor  reads. 

(EVALQUOTE  (LAMBDA  (  )   (PROG  SI  S2  ARGS) 

A     (TEREAD) 

(SETQ  ARGS  NIL) 

(SETQ  SI  (READ)) 

(SETA  S2  (READ)) 
B     (COND  ((NULL  S2)   (GO  C))) 

(SETQ  ARGS  (CONS  (LIST  (QUOTE  QUOTE)  (  CAR  S2))  ARGS)) 

(SETQ  S2  (CDR  S2)) 

(GO  B) 
C     (PRINT  EVAL  (CONS  SI  (REVERSE  ARGS)))) 

(GO  A)  )))2 


2 
Clark  Weissman,  LISP  1.5  Primer,  (Belmont,  1968),  p.  131. 
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1.  IBM  7090  LISP  Supervisor 

In  7090  LISP  the  EVALQUOTE  function  is  called  the  interpreter, 

while  the  supervisor  (or  monitor)  is  a  separate  function  called  the  Over- 

4  ,  , 

lord.    The  7090  Overlord  handles  the  I/O,  maintains  the  system's  files 

and  handles  dumps.   Since  7090  LISP  receives  punched  cards  as  input,  the 

overlord  is  essentially  a  batch  processing  supervisor.   Its  main  function 

seems  to  be  that  of  handling  of  the  five  tape  drives  the  7090  system  uses, 

These  tapes  are  listed  here  by  name  and  function. 

SYSTAP        Contains  the  System 

SYSTMP         Receives  the  Core  Image 

SYSPIT         Punched  Card  Input 

SYSPOT         Printed  Output 

SYSPPT         Punched  Card  Output 

After  the  LISP  system  is  called  by  the  LISP  loader  (two  special 
cards),  the  Overlord  takes  over  and  initializes  the  system.   From  then  on 
the  Overlord  is  in  control,  checking  each  card  in  the  input  stream  to  see 
if  it  is  an  Overlord  direction  card.   These  Overlord  cards  direct  the 
Overlord  to  perform  some  specific  function  or  else  tell  it  that  a  LISP 
deck  (called  a  packet  of  doublets)  follows.   The  packet  of  doublets  is  a 
deck  of  pairs  of  S-expressions  for  the  interpreter.   The  Overlord  con- 
tinues as  described  above  until  it  reads  a  'FIN*  Overlord  card,  at  which 
time  it  halts. 

2.  0-32  LISP  Supervisor 

The  0-32  LISP  system  is  a  compiler-oriented  rather  than  an 


4 
J.  McCarthy,  and  others,  LISP  1.5  Programmer's  Manual  (Cambridge, 

1962),  p.  80. 
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Interpreter-oriented  language.    When  run  under  time-sharing,  the  user 
sees  two  modes  of  operation:   the  Executive  mode  and  the  Object  Program 
mode.    The  Executive  mode  is  the  mode  used  to  communicate  with  the  time- 
sharing executive  and  is  analogous  to  CMS  when  running  LISP  under  CP/CMS. 
The  Object  Program  mode  is  analogous  to  the  NPS  LISP  1.5  VERS  1  Super- 
visor; therefore,  it  is  this  mode  we  wish  to  examine  here. 

The  Q-32  LISP  supervisor  (accessible  in  the  Object  Program  mode) 
is  a  function  *SUPV  "which  calls  for  two  S-expressions  to  be  read  from 
the  teletype,  terminates  the  input  buffer,  then  calls  for  (PRINT  (*EVALQT 
X  Y  (QUOTE*FUNC)))  and  loops  back  to  call  for  two  more  S-expressions." 
The  prefix  *  indicates  that  the  function  is  a  basic  system  function  not 
normally  useful  to  the  user.   The  arguments  X  and  Y  of  *EVALQT  are  the 
two  S-expressions  read  from  the  teletype.   Thus,  despite  differences  such 
as  being  compiler-oriented,  the  Q-32  LISP  supervisor  is  basically  similar 
to  the  general  supervisor  described  by  Weissman  [Ref.  2],   The  function 
*EVALQT,  of  course,  is  EVALQUOTE  though  *EVALQT  has  three  arguments  (one 
being  required  by  the  Compiler). 

Rather  extensive  I/O  is  possible  by  using  special  LISP  I/O 
functions.   The  Supervisor  handles  these  functions  in  the  same  way  it 
handles  the  basic  LISP  functions.   The  function  SAVE  (n) ,  for  example, 
dumps  LISP  core  in  the  same  manner  as  the  DUMP$  command  of  the  NPS  LISP 
Supervisor  (See  Section  II. C. 3).   Thus  every  Q-32  LISP  function  is  a 
supervisor  command. 


S.  L.  Kameny,  LISP  1.5  Reference  Manual  for  Q-32  (Santa  Monica, 


1965)  p.  7 
6 


Ibid,  p.  8. 

7Ibid,  p.  64. 
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For  further  discussion  of  the  Q-32  LISP  supervisor  see  Section 
4.3  of  Reference  8. 

3.  BBN  LISP  Supervisor 

BBN  940  LISP  is  a  version  of  LISP  implemented  on  the  SDS  940 
computer  by  Bolt  Beranek  and  Newman,  Inc.,  [Ref.  4].   It  is  primarily  of 
interest  here  because  of  its  Editor,  which  will  be  discussed  in  Section 
III. 

The  BBN  LISP  Supervisor  is  called  EVALQUOTE  and  performs  the 
standard  functions  of  reading  S-expression  doublets  and  executing  them. 
Input-Output  functions,  file  manipulation,  and  editor  commands  are  all  in 
the  form  of  S-expressions  doublets  and  are  all  handled  by  EVALQUOTE. 
Thus,  as  with  Q-32  LISP,  all  LISP  commands  are  supervisor  commands. 

4.  General  Functions  and  Capabilities  of  the  NPS  LISP  1.5  VERS  1 
Supervisor 

The  NPS  LISP  1.5  VERS  1  Supervisor  is  a  PL/I  program  which 

performs  the  followsing  tasks: 

1.  Calls  the  LISP  initializer  to  start  the  system, 

2.  Handles  the  SPECIAL  (automatic)  OPTIONS  requests, 

3.  Sets  and  supervises  the  two  user-oriented  modes  of 
system  operation  (i.e.,  Editor  mode  or  Interpreter 
mode),  switching  the  system  from  one  mode  to  the 
other  as  the  user  requests, 

4.  Handles  user  requested  dumps, 

5.  Loads  specialized  system  files  on  request, 

6.  Calls  the  Garbage  Collector  at  the  request  of  the 
user, 

7.  Handles  the  close-out  routine  when  a  LISP  run  is 
terminated  by  the  user. 

These  functions,  and  the  Supervisor  language,  are  discussed  in 

the  sections  that  follow.   The  VERS  1  Supervisor  is  similar  to  those 
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described  above,  except  that  housekeeping  chores  are  peculiar  to  the 
Supervisor.   This  eliminates  the  necessity  of  the  VERS  1  system  supporting 
a  number  of  specialized  LISP  functions. 

In  conclusion,  I  wish  to  point  out  that  though  the  'Overlord' 
of  7090  LISP  is  essentially  a  batch  processing  monitor,  it  nevertheless 
does  for  7090  LISP  what  the  VERS  1  Supervisor  does  for  NPS  LISP.   It  is 
therefore  fair  to  say  that  the  NPS  LISP  1.5  VERS  1  Supervisor  more  closely 
resembles  the  7090  LISP  system  than  any  of  the  other  systems  studies. 
Thus  both  the  VERS  1  Supervisor  and  Interpreter  use  the  7090  system  as 
a  pattern. 

The  terminology  'S-expression  doublet'  has  been  borrowed  from 
the  description  of  7090  LISP  [Ref.  7]  and  will  be  used  in  this  thesis. 
The  description  of  the  VERS  1  Supervisor  begins  with  the  following  dis- 
cussion of  the  automatic  features. 

B.    AUTOMATIC  FEATURES  OF  THE  VERS  1  SUPERVISOR 

Experience  gained  from  work  on  the  terminal,  using  CP/CMS,  led  to 
the  incorporation  into  the  Supervisor  of  two  optional  automatic  features. 
What  follows  is  a  description  of  these  features  and  a  discussion  of  the 
reasons  for  their  inclusion  in  the  VERS  1  system. 

It  often  happens  that  a  user  must  make  so  many  corrections,  dele- 
tions and  additions  to  his  input  string,  that  it  becomes  almost  unintel- 
ligible.  This  fact  motivated  the  first  automatic  option,  the  printback 
feature.   This  feature  prints  back  the  string  the  LISP  Interpreter  has 
actually  received  and  numbers  the  first  line  of  each  doublet. 

Another  feature  which  seemed  desirable,  due  to  sometimes  too  f re- 
frequent  CP  "crashes",  was  an  automatic  LISP  storage  saving  routine. 
The  term  "crash"  is  a  popular  but  descriptive  term  which  refers  to  an 

15 


abrupt  halt  in  service  due  to  a  malfunction  in  the  time-sharing  system. 
The  CP  time-sharing  system  is  not  immune  to  such  crashes.   Without  an 
automatic  dump  routine  a  user  would  have  to  reinitialize  the  LISP  system 
and  start  over  again  after  each  crash.   This  could  be  very  frustrating 
and  time  consuming.   The  AUTOSAVE  feature  was  therefore  incorporated  and 
is  described  below.   Either  feature  can  be  abled  or  disabled  at  any  time 
after  initialization  of  the  system. 

Immediately  after  the  system  has  initialized,  the  question  "SPECIAL 
OPTIONS?"  will  be  typed  on  the  terminal.   This  is  the  only  time  this 
explicit  question  will  be  asked.   If  neither  option  is  desired,  the  user 
should  respond  by  typing  "N"  or  "NONE".   The  default  condition  for  a 
"NONE"  response  is  autosave  and  printback  disabled. 

If  the  user  wishes  to  change  his  current  options,  he  can  do  so  by 
using  the  OPT$  command.   This  is  a  Supervisor  command  and  is  discussed 
here  since  it  is  used  exclusively  with  the  automatic  options.   The  Super- 
visor returns  control  to  the  Interpreter  after  honoring  the  OPT$  request. 

1.  OPT$  command 

OPT$  list 

This  command  causes  the  supervisor  to  change  the 
current  special  options  listed  in  "list."  Options 
in  "list"  (if  more  than  one)  must  be  separated  by 
at  least  one  blank.   If  the  "list"  is  missing,  the 
command  is  ignored.   (The  commands  'OPTION$'  or 
'OPTIONS$'  are  also  valid. 

2.  PRINTBACK  option 

P    (  NP  ) 

The  'P'  command  causes  each  S-expression  doublet 
received  by  the  Interpreter  to  be  printed  back 
with  its  sequence  number.   'NP',  typed  in  the 
"list"  of  the  OPT$  command  disables  the  print- 
back  feature. 
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3.    AUTOSAVE  option 

AUTOS AVE  f=n]  (NAS) 

The  autosjave  feature,  which  is  called  by  this  command, 
automatically  dumps  LISP  memory  into  file  AUTOLISP 
every  5  doublets  unless  a  different  line  parm  value 
has  been  specified.   AUTOLISP  is  erased  during  the 
closeout  routine  called  by  the  user  typing  'END  LISP1. 
The  bounds  on  the  line  parm,  n,  are:   1<  n-  20.   'NAS' 
typed  in  the  "list  of  the  OPT$  command  erases  the 
file  AUTOLISP  and  disables  the  autosave  feature.   The 
autosave  feature  also  creates  an  exact  copy  of  file 
LISPTEXT  (the  working  file  of  the  Editor)  each  time 
it  dumps  the  LISP  memory.   This  copy  is  a  file  called 
LISPTEMP.   (For  further  discussion  of  these  files 
see  the  following  subsection). 

If  a  CP  crash  occurs,  the  version  of  AUTOLISP  and  LISPTEMP  created 

by  the  last  autosave  dump,  will  remain,  unaffected,  on  the  user's  disk. 

The  user  will  see  a  message,  reminding  him  of  the  existence  of  these 

files  when  he  reinitializes  the  LISP  system.   The  user  should  load  these 

files  at  the  first  communication  from  the  Interpreter  or  they  will  be 

automatically  erased.   The  Interpreter  tells  the  user  it  is  ready  by 

displaying  'CALL  EVALQUOTE,  ARGS ' . 

g 
The  PL/I  file  handling  routine  IHEFILE  is  used  to  create  the  files 

LISPTEMP,  AUTOLISP,  and  DUMPLISP.   For  this  reason  it  is  briefly  mentioned 

in  the  discussion  that  follows. 

a.    Files  AUTOLISP  and  DUMPLISP 

The  PL/I  file  handling  routine  IHEFILE  is  described  fully 

in  Reference  5.   For  our  present  requirements  it  is  enough  to  know  that 

this  routine  creates  a  file  on  the  user's  disk  by  storing  an  80  character 

buffer  in  the  file  each  time  the  routine  is  called  in  the  PL/I  program. 


o 
CP/CMS  User's  Guide  (Revised  6.69),  Naval  Postgraduate  School, 
Comouter  Facility  (Monterey,  1969),  p.  385. 
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Since  this  routine  is  used  to  create  files  AUTOLISP  and  DUMPLISP,  an 
immediate  problem  presented  itself.   How  do  we  efficiently  convert  binary 
fixed  data  (the  LISP  memory  is  in  this  form)  into  a  character  string? 

The  method  chosen  for  the  NPS  LISP  1.5  VERS  1  system  was  to  use  the  com- 

9 
oaratively  fast  UNSPEC   function  of  PL/I  to  put  the  internal  representa- 
tion of  each  word  of  LISP  memory  into  a  4  character  substring  of  the  buf- 
fer.  This  stores  20  words  of  FSTOR  each  time  the  IHEFILE  routine  is 
called.   Since  LISP  core  is  initially  set  up  as  a  sequentially  linked 
list  (i.e.,  the  cells  are  an  array  called  FSTOR,  linked  by  storing  in 
each  word  the  array  subscript  of  the  next  word),  there  is  usually  a 
sizeable  percentage  of  LISP  memory  which  consist  of  adjacent  cells  con- 
taining numbers  in  sequence  (see  Fig.  1).   This  is  especially  true  if 
the  Garbage  Collector  has  not  been  used  and/or  the  user's  program  is  not 
extremely  large.   Therefore,  to  increase  the  speed  of  the  dump  and  de- 
crease the  size  of  the  storage  area  required  for  file  AUTOLISP,  the  fol- 
lowing structure  for  file  AUTOLISP  (as  well  as  file  DUMPLISP)  was  adopted. 

The  structure  of  the  file  AUTOLISP  can  be  thought  of  in 
two  ways.   One  way  is  to  think  of  it  as  a  set  of  80  character  strings, 
each  of  which  was  stored  from  the  buffer  CARD-BUFFER  by  one  call  to  the 
IHEFILE  routine.   (See  Fig.  2,  Physical  Structure.)   Thus,  to  access 
an  item,  one  needs  the  character  string  number  and  the  location  of  the 
item  in  the  character  string.   The  other  way  of  viewing  AUTOLISP  is  as  a 
seauential  storage  area  where  an  item  is  accessed  by  knowing  its  sequen- 
tial address.   (See  Fig.  2,  Sequential  Structure.)   Both  representations 
of  AUTOLISP  are  used  by  the  dump  routine. 


IBM  System/360  Reference  Manual,  International  Business  Machines 
Corporation  (1968),  p.  237. 
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The  first  word  of  AUTOLISP  (bytes  1-4  of  the  first  80 
character  string)  is  called  a  Keyword.   The  first  halfword  of  a  keyword 
contains  the  sequential  address  of  the  next  keyword.   (The  "sequential 
address",  as  opposed  to  a  "physical  address",  refers  to  a  sequential 
location  of  a  word.)   The  second  two  bytes  of  a  keyword  contain  a  number 
C.   When  the  dump  routine  encounters  more  than  two  adjacent  words  in 
FSTOR  which  contain  sequential  numbers,  (as  for  example,  FSTOR(IOOO) 
FSTOR(lOOl)  FSTOR(1002)  in  Fig.  1),  the  next  available  sequential  address 
becomes  the  address  of  a  new  keyword  and  is  stored  in  the  first  two  bytes 
of  the  last  keyword.   The  first  word  of  the  FSTOR  sequence  (FSTOR(IOOO) 
in  the  example  above)  is  then  stored  following  this  new  keyword.   The 
number  of  words  in  the  sequence,  C,  is  stored  in  the  last  two  bytes  of 
the  new  keyword.   (For  clarification  see  Fig.  3).   In  this  way  storage 
time  and  area  can  be  minimized.   Of  course  if  most  of  LISP  memory  is 
active  or  if  it  has  been  reshuffled  due  to  numerous  garbage  collections, 
the  advantages  of  this  system  will  be  minimized. 

A  discussion  of  the  other  files  affected  by  the  dump 
routine  follows. 

b.    Files  LISPTEXT  and  LISPTEMP 

File  LISPTEXT  is  the  file  used  by  the  Editor.   Each  doublet 
input  by  the  user  is  stored  in  LISPTEXT  in  sequence  with  its  sequence 
number  in  the  first  byte  of  the  first  line.   The  input  is  stored,  starting 
with  line  2  of  LISPTEXT.   The  first  line  of  LISPTEXT  is  used  for  two  pur- 
poses, storing  certain  values  which  are  required  by  the  load  routine  and 
storing  a  code-byte  (C-byte)  used  by  the  Supervisor.   The  C-byte  is  the 
first  byte  of  the  first  line.   The  possible  values  of  the  C-byte  and 
resulting  Supervisor  actions  are  given  in  Table  I. 


21 


The  values  stored  on  line  1  of  file  LISPTEXT  are  stored 
there  by  the  DUSAVE  PL/I  routine  called  each  time  a  dump  occurs.   (DUSAVE 
is  called  by  both  the  autosave  feature  and  by  the  DUMP$  command.)   These 
are  the  values  of  certain  PL/I  variables  which  are  listed  in  Table  II. 

The  C-byte  is  set  by  various  Supervisor  routines.   The 
PL/I  listing  of  these  routines  can  be  found  in  APPENDIX  C.   (The  major 
PL/I  modules  which  make  up  the  VERS  1  system  are  LISPA,  LISPB,  LISPC, 
LISPD,  LISPE,  LISPF,  LISPG,  and  LISPP.   Each  module  is  listed  in  AP- 
PENDIX B  with  its  major  function.)   The  C-byte  is  set  to  the  value  ' 1* 
by: 

1.  The  close-out  procedure  if  its  value  is  '2'  when  that  procedure 
is  entered.   The  close-out  procedure  is  located  in  LISPA  fol- 
lowing the  lable  TERM. 

2.  The  procedure  which  handles  the  ,OPT$  NAS '  input.  This  pro- 
cedure disables  the  autosave  feature  and  is  located  in  LISPA 
following  the  label  SCN1. 

3.  The  file  LISPTEXT  handler,  when  the  first  S-expression  doublet 
is  entered  and  the  autosave  feature  has  not  been  enabled. 
This  routine  follows  entry  point  TEXTWRK  in  LISPA. 

The  C-byte  is  set  to  '2'  by  two  routines.   The  first  is  the  routine  which 
processes  the  'AUTOSAVE*  command.   This  procedure  is  located  in  LISPA 
following  the  label  SCN1.   The  second  is  the  TEXTWRK  routine  of  (c)  above. 
This  routine  will  set  the  C-byte  to  '2'  when  the  first  doublet  is  input 
if  the  autosave  option  has  been  chosen.   The  value  '3'  is  set  by  the 
routine  which  processes  the  DUMP$  command.   This  routine  is  located  in 
LISPA  following  the  label  CMD. 

Since  the  file  LISPTEXT  contains  the  current  C-byte  value, 
some  version  of  it  resides  on  the  user's  disk  at  all  times.   The  message 
telling  of  the  existence  of  file  LISPTEXT  actually  refers  to  the  exist- 
ence of  file  LISPTEMP,  an  exact  copy  of  LISPTEXT  at  the  time  of  the  dump. 
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TABLE  I 

FILE  LISPTEXT  FLAG  VALUES  AND 
CORRESPONDING  SUPERVISOR  ACTION 


C-byte  VALUE 


MEANING 


SUPERVISOR  ACTION 


Previous  exit  from  LISP 
system  was  normal  and 
no  dump  was  requested 


reinitializes 
LISPTEXT 


Previous  exit  from 
LISP  system  was  ab- 
normal with  AUTOSAVE 
option  enabled. 


Prints  message: 

" FILES  LISPTEXT 

AND  AUTOLISP 
EXIST--" 


any  other 
value 


A  dump  was  requested 
before  previous  exit 
from  LISP  system 


File  LISPTEXT  does  not 
exist  in  a  usable  form 
on  the  user's  disk. 


Prints  message: 
" — FILES  LISPTEXT 
AND  DUMPLIST 
EXIST — " 

Initializes  file 
LISPTEXT 


TABLE  II 
PL/I  VARIABLES  STORED  IN  FILE  LISPTEXT 


PL/I  VARIABLE 


FUNCTION 


POSITION  (f,e)* 


LCOUNT 

CARDNOI 

E START 

EFSTOR 

FREE 

BNUM 


S-expression  doublet  counter  (2,4) 

Next  available  line  in  LISPTEXT  (6,4) 

Pointer  used  by  the  Editor  (10,4) 

Last  cell  in  Free  Storage  (14,4) 

First  cell  in  Free  Storage  (20,4) 

Next  available  cell  for  numbers  (30,4) 


*  Location  in  character  string:  f=position  of  first 
character  of  substring,  l=length  of  substring 
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Thus,  though  the  user  may  *LOAD$  LISPTEXT',  the  file  that  is  actually 
loaded  is  LISPTEMP.   The  only  time  confusion  may  occur  is  if  the  user 
wishes  to  edit  the  LISPTEXT  he  has  dumped,  using  the  CMS  editor  (See 
Ref.  5).   He  must  then  be  sure  to  'EDIT  LISPTEMP  DATA'.   LISPTEMP  does 
not  exist  on  the  user's  disk  if  no  dump  has  occurred. 

The  foregoing  discussion  of  the  VERS  1  special  files  con- 
cludes the  subsection  concerned  with  the  automatic  features  of  the  Super- 
visor.  These  files  will  be  mentioned  frequently  in  the  sections  that 
follow.   The  next  subsection  describes  the  various  Supervisor  commands. 

C.    SUPERVISOR  COMMANDS 

As  pointed  out  in  Section  II. A,  all  Supervisor  commands  end  in  the 
symbol  '$'.   The  user  issues  all  Supervisor  commands  in  response  to  the 
standard  "ready"  of  the  interpreter.   (See  Section  II. B. 3.)   The  syntax 
analyzer,  entry  point  NREAD  of  LISPC,  scans  the  first  S-expression, 
recognizes  that  the  first  S-expression  is  an  atom  ending  in  a  '$'  and 
alerts  the  Supervisor.   The  Supervisor  then  takes  control,  scans  the  com- 
mand and  takes  the  appropriate  action.   The  Supervisor  commands  and  their 
effects  are  listed  below.   The  PL/I  routines  that  implement  these  com- 
mands are  located  in  LISPA  unless  otherwise  specified.   (See  APPENDIX  C 
for  a  listing  of  LISPA.) 

1.  OPT$   See  Section  II.B.l. 

2.  EDIT$ 

EDIT$ 

In  response  to  the  EDIT$  command,  the  supervisor  gives 
control  to  the  LISP  Editor.   The  Editor  will  respond  by 
typing  'EDIT  LISP'.   It  is  then  ready  for  an  input  from 
the  user.   (The  command  *  E$'  is  also  valid.) 

3.  DUMP$ 
DUMP$ 
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The  DUMP$  command  tells  the  Supervisor  to  dump  LISP 
memory  into  file  DUMPLISP  which  is  erased  automatically 
by  the  next  DUMP$  command  or  after  it  is  loaded  by  the 
LOAD$  command. 

The  file  LISPTEXT  is  also  saved  by  the  DUMP$  command  as  well  as  the 
values  of  the  PL/I  variables  ESTART,  FREE,  BNUM,  LCOUNT,  EFSTOR,  and 
CARDNO  1  which  are  needed  to  restore  memory  (See  Section  II.B.3.(b)). 
The  DUMP$  routine  uses  the  PL/I  procedure  DUSAVE,  an  entry  point  in 
LISPF,  which  is  also  used  by  the  AUTOSAVE  option.   (See  APPENDIX  C.) 
Since  files  DUMPLISP  and  AUTOLISP  have  the  same  structure,  the  dis- 
cussion of  file  AUTOLISP  in  Section  II. B. 3.  applies  also  to  file  DUMPLISP. 

Upon  initialization  of  the  LISP  system,  if  DUMP$  was  used  on  the  pre- 
vious run  (and  hence  files  DUMPLISP  and  LISPTEMP  are  on  the  user's  disk), 
the  user  will  be  warned  of  this  fact  by  a  message  (See  Table  I). 

4.  LOAD$ 

LOAD$  filename  [filename] 

The  LOAD$  command  loads  "filename"  into  LISP  memory 
except  when  "filename"  is  LISPTEXT.   In  this  case 
LISPTEMP  is  loaded  and  renamed  LISPTEXT.   If  more 
than  one  file  is  loaded,  the  filenames  must  be  separ- 
ated by  at  least  one  blank.   During  the  load,  a 
message  will  be  displayed,  telling  which  file  is 
currently  being  loaded. 

5.  QUIT$ 

QUIT$ 

The  QUIT$  command  causes  the  Supervisor  to  take  control 
from  the  interpreter,  delete  what  has  been  typed  of  the 
S-expression  doublet  being  input,  reinitialize  the 
Interpreter  and  return  control  to  it.   The  Editor  is 
also  told  to  remove  the  same  input  from  LISPTEXT. 
(Q$  is  a  recognized  abbreviation). 

6.  COUNT$ 
COUNT$ 
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The  COUNT$  command  causes  a  count  to  be  made  of  the 
number  of  free  cells  in  LISP  memory.   The  result  is 
a  message  from  the  Supervisor,  CELLS  IN  FREE  STORAGE:  n 
CELLS  AVAILABLE  FOR  NUMBERS:   m 
where  n  and  m  are  decimal  numbers. 

7.    COLLECT$  and  COLLECTN$ 

COLLECT$ 

This  is  the  call  to  the  Garbage  Collector,  which  will 
collect  in  both  main  storage  and  number  storage.   For 
discussion  of  the  Garbage  Collector  and  LISP  memory 
structure  see  Section  IV. B. 

COLLECTN$ 

In  response  to  the  COLLECTN$  command  the  Garbage 
Collector  will  collect  only  in  number  storage. 

This  concludes  the  discussion  of  the  Supervisor.   The  following 

section  describes  the  NPS  LISP  1.5  VERS  1  Editor. 
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III.   THE  EDITOR 

A.    EDITING  LISP  PROGRAMS  IN  AN  INTERACTIVE  ENVIRONMENT 

The  editor  of  the  CP/CMS  system  is  one  of  that  system's  most  used 
features.   This  is  natural  since  one  of  the  prime  advantages  of  an  inter- 
active system  is  the  ability  to  correct  mistakes  as  soon  as  they  are 
detected  or  to  make  program  changes  in  an  environment  which  allows  al- 
most immediate  analysis  of  their  effects.   These  factors  motivated  the 
design  of  NPS  LISP  1.5  VERS  1  Editor.   Other  systems  studied  were  7090 
LISP,  BBN  LISP,  Q-32  LISP  and  the  implementation  of  the  Georgia  Tech 
LISP  interpreter  at  the  University  of  Washington.   It  was  evident  that 
little  had  been  documented  in  the  field  of  LISP  editors.   Of  those  studied, 
the  BBN  LISP  editor  was  the  only  system  with  an  editor.   It  is  summarized 
below. 

A  fundamental  difference  between  the  NPS  LISP  1.5  VERS  1  Editor  and 
the  BBN  system  must  be  emphasized.   The  editors  of  all  LISP  systems  have 
S-expressions  as  the  data  on  which  they  operate.   The  difference  between 
the  VERS  1  Editor  and  the  others  is  found  in  the  structure  of  the  S- 
expressions.   The  other  systems  operate  on  S-expressions  which  are  stored 
as  lists  (their  tree  structure).   The  editor  commands  of  these  systems 
are  LISP  functions  which  traverse  S-expression  trees  and  "edit"  using 
LISP  primitive  functions  to  alter  the  structure  of  these  trees.   There 
are  certain  obvious  advantages  to  this  type  of  editor.   Some  of  these  are 
all  editor  commands  are  LISP  functions, 

the  structure  of  data  for  the  editor  is  the  same  as  for  the 
the  supervisor  and  interpreter, 

an  operation  on  an  S-expression  directly  alters  the  structure 
of  that  S-expression. 
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The  VERS  1  Editor  operates  on  the  material  stored  in  file  LISPTEXT.   Here 
S-expression  doublets  are  stored  as  character  strings,  the  form  in  which 
they  were  input.   The  VERS  1  Editor  commands  are  not  LISP  functions; 
they  make  up  a  separate  language.   Finally,  an  operation  by  the  VERS  1 
Editor  alters  the  character  string  structure  of  a  doublet  in  LISPTEXT, 
not  its  list  structure  in  LISP  memory.   Hence  the  doublet  must  be  "re- 
computed" by  the  Interpreter  after  editing,  for  the  editing  to  have  ef- 
fect. 

Before  going  into  detail  on  the  VERS  1  Editor,  it  would  be  instruc- 
tive to  look  at  the  BBN  LISP  editor.   This  editor  is  rather  sophisticated 
and  the  next  subsection  is  concerned  exclusively  with  some  of  its  fea- 
tures. 

I.    BBN  LISP  Editor 

The  BBN  LISP  Editor  is  an  extensive  and  distinct  subsystem 
of  the  BBN  LISP  system.   It  "allows  rapid,  convenient  modification  of 
list  structures.   Most  often  it  is  used  to  edit  function  definitions, 
often  while  the  function  itself  is  running."    It  has  many  functions, 
allowing  the  user  a  choice  of  ways  to  accomplish  a  particular  editing 
requirement.   The  editor  commands  are  short,  usually  consisting  of  a 
single  character. 

The  BBN  LISP  Editor  operates  directly  on  list  structure. 
The  particular  list  that  is  to  be  edited  is  indicated  in  the  call  to  the 
editor.   For  example, 

EDITF  (APPEND) 


D.  G.  Bobrow,  and  others,  The  BBN  940  LISP  System  (1967),  p.  40 
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would  bring  the  editor  on  line  and  specify  the  function  definition  of 
APPEND  as  the  list  to  be  edited.   There  are  four  different  commands  for 
calling  the  editor,  depending  on  the  type  of  list  structure  to  be  edited. 
The  basic  function,  for  editing  S-expressions,  is  the  function  EDITE. 
The  other  three  are 

1.  EDITV,  for  editing  values 

2.  EDITF,  for  editing  function  definitions,  and 

3.  EDITP,  for  editing  property  lists. 

These  functions  confine  their  attention  to  only  one  list  at  a  time, 
usually  the  sublist  of  some  major  structure.   Changes  may  be  made  only 
to  this  particular  sublist.   "Commands  thus  fall  naturally  into  four 
classes:  moving  around  the  last  structure;  making  changes  in  the  current 

list;  orinting  parts  of  the  list  being  edited;  and  entering  and  leaving 

„11 

the  editor." 

a.    List  Traversal  Commands 

List  traversal  is  accomplished  by  typing  a  number  n  to 
indicate  the  nth  level  from  the  top  of  the  main  list  structure  which  is 
to  be  examined.   A  '-n1  examines  the  nth  sublist  starting  from  the  end 
of  the  main  structure  and  counting  back  n  sublists.   The  command  t  re- 
establishes the  top  level  of  the  main  structure  as  being  current.   To 
traverse  from  a  current  sublist  one  can  use  the  command  (NTH  n)  which 
uses  the  current  sublist  as  a  starting  place  and  causes  the  nth  sublist 
from  that  point  to  become  current.   The  command  'P'  is  used  to  print  the 
current  list.   If  the  current  list  is  the  main  structure,  a  LISP  represen- 
tation of  the  entire  structure  will  be  printed.   The  command  (F  e)    searches 


11 

Ibid,  p.  41. 
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for  an  occurrence  of  e_  in  the  current  list,  where  e_  is  any  S-expression. 
The  number  0  causes  the  previously  current  list  to  become  current.  These 
commands  allow  great  flexibility  in  traversing  list  structures.  Even 
greater  flexibility  is  obtained  by  a  function  MARK  which  allows  the  user 
to  mark  the  current  state.  He  may  then  return  later  by  typing  *-  which 
returns  him  to  the  last  mark  without  erasing  the  mark  or  by  >*-■*-  which 
does  the  same  thing,  but  erases  the  mark. 

COPY  and  RESTORE  are  the  last  two  list  traversal  commands 
which  will  be  specifically  mentioned.   Since  every  change  made  is  made 
directly  to  the  internal  list  structure,  the  COPY  command  can  be  issued 
before  changes  are  made.   This  copies  the  "current  state  of  the  edit", 
so  that  the  user  may  later  restore  the  system  to  its  previous  state  by 
issuing  a  RESTORE  command. 

b.    Modification  Commands 

The  capabilities  of  inserting,  replacing  and  appending 

list  structures  is  provided  by  the  three  commands,  (-n  ei,...,e  ), 

1  m 

(n  e    ,...,e   )    and    (N  e.,...,e   )   where   e,,...,e     are   S-expressions. 
1  m  1  m  1  m 

The  'n's  are  integers  which  indicate  the  nth  sublist  from  the  current 

one.   Thus  (-1  ABC)  would  insert  ABC  before  the  current  sublist,  and 

(2  ABC)  would  replace  the  2nd  sublist  from  the  current  sublist  with  ABC. 

The  'N*  is  used  to  append  S-expressions.   To  delete,  use  the  replace 

command  with  no  replacement  S-expression  specified.   The  command  (R  e.  e_) 

replaces  all  occurrences  of  list  e  with  e   in  the  current  list  and  all 

sublists. 

Direct  alteration  of  the  list  structure  itself  is  also 
possible.   This  is  done  with  commands  such  as  LO  (take  Left  paren  Out), 
BO  (take  Both  parenthesis  Out),  (RO  n  m)  and  (RI  n  m) .   The  last  command 
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(RI  n  m)  will  be  illustrated.   Consider  the  list  (A  B(C  D  E)  F  G) .   If 
we  want  to  bring  the  D  and  E  up  to  the  level  of  A  B  F  G  and  leave  (c) 
as  a  sub  list,  we  could  use 

(RI  3  1) 
which  means  move  the  Right  paren  at  the  end  of  sublist  3  In  to  sub  list 
3  and  place  it  after  sublist  I  of  sublist  3.   The  results  is  the  list 
(A  B  (C)  D  E  F  G). 

c.    Printing  Commands 

The  command  P  which  prints  the  current  list,  showing  only 
one  level  of  nesting,  was  presented  in  subsection  a.   To  print  a  selected 
sublist  without  changing  the  current  state  of  the  edit,  a  (P  n)  command 
could  be  used.   This  would  print  the  nth  sublist  from  the  current  one. 
(P  n  m)  prints  the  nth  sublist  to  m  levels  of  nesting.   Finally,  (E  c) 
prints  the  sublist  c  without  changing  the  state  of  the  edit. 

The  BBN  LISP  editor  is  a  highly  sophisticated  subsystem. 
A  good  knowledge  of  LISP  1.5  is  required  to  use  it.   It  has  the  dangers 
which  result  from  being  able  to  directly  alter  its  memory,  but  the  ad- 
vantages of  speed  and  versatility  far  outweigh  any  disadvantages. 

A  general  discussion  of  the  NPS  VERS  1  Editor  follows. 
2.    NPS  LISP  1.5  VERS  1  Editor 

The  NPS  LISP  Editor  performs  the  following  functions: 

1.  Prints  S-expression  doublets, 

2.  Changes  the  character  string  representation  of 
S-expressions, 

3.  Recomputes  specified  doublets, 

4.  Lists  atoms,  functions,  or  special  forms  from 
OBLIST, 

5.  Deletes  atoms  and  functions  from  OBLIST. 
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All  but  the  last  two  of  these  functions  depend  upon  LISPTEXT. 
The  last  two  functions  are  performed  by  traversing  OBLIST. 

Every  doublet  entered  into  the  VERS  1  system  is  stored  in 
LISPTEXT.   The  Editor  accesses  a  particular  doublet  by  traversing  a  list 
to  locate  that  doublet's  sequence  number.   The  pointer  to  the  head  of 
this  list  is  the  PL/I  variable  ESTART  (See  Table  II).   Each  doublet 
entered  by  the  user  is  assigned  a  unique  number.   This  number  is  stored 
in  the  CAR  of  a  word  in  FSTOR  whose  CDR  is  another  word  in  FSTOR.   The 
CAR  of  this  second  word  is  the  line  number  in  LISPTEXT  of  the  first  line 
of  the  doublet.   Thus,  to  find  doublet  number,  n,  the  Editor  traverses 
the  ESTART  list,  starting  at  ESTART.   If  CAR(ESTART)  is  not  equal  to  n 
then  it  checks  CADDR (ESTART) ,  and  so  on  until  n  is  located.   The  required 
line  number  in  LISPTEXT  is  the  CADR  of  this  cell.   To  operate  on  this 
doublet,  the  Editor  would  then  read  this  line  into  CARD-BUFFER  using  the 
IHEFILE  routine.   An  obvious  disadvantage  of  this  system  is  that  only 
part  of  a  doublet  can  be  worked  on  at  any  instant.   Thus  the  CHANGE  func- 
tion requires  that  all  changes  be  made,  one  line  at  a  time,  not  allowing 
part  of  a  field  to  be  on  one  line  while  the  remainder  is  on  the  next. 
When  all  changes  are  made,  the  changed  doublet  must  be  recomputed  before 
the  changes  have  any  effect  upon  the  LISP  list  structure.   This  is  one 
advantage,  since  ill-conceived  changes  will  not  take  immediate  effect, 
as  in  the  BBN  Editor. 

The  commands  which  make  up  the  language  of  the  NPS  VERS  1 
Editor  are  listed  and  discussed  in  the  section  that  follows. 

B.    EDITOR  COMMANDS 

The  Editor  initially  tells  the  user  it  is  on-line  by  typing  the 
message  'EDIT  LISP'.   The  Editor  will  remain  on-line  until  it  receives 
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the  'RET*  command  or  the  'END  LISP'  command.   Any  user  error  in  issuing 
an  edit  command  will  result  in  one  of  two  responses  by  the  Editor. 
Either  the  Editor  will  ignore  the  faulty  edit  command  and  wait  for  another 
input,  or  it  will  type  an  error  message  and  wait  for  another  input.   See 
APPENDIX  A  for  the  error  messages.   The  Editor  commands  are  discussed  be- 
low. 

1.  RET  (RETURN) 

RET   (RETURN) 

The  RET  command  returns  control,  to  the  Interpreter 
through  the  Supervisor.   When  this  is  done  the  user 
will  see  the  standard  Interpreter  challenge, 
'CALL  EVALQUOTE,  ARGS: *  typed  on  his  terminal. 

2.  PRINT 

P     (PRINT)  n[,m] 

The  PRINT  command  tells  the  Editor  to  find  S- 
expression  doublet  number  "n"  and  display  it. 
A  pointer,  used  for  the  CHANGE  function,  is 
also  positioned  at  this  doublet.   If  "m"  is 
specified  then  the  m-1  following  doublets  will 
also  be  displayed  (for  a  total  of  "m"  doublets). 
If  this  is  the  case,  the  CHANGE  pointer  will  be 
pointing  to  the  last  doublet  displayed. 

3.  CHANGE 

C    (CHANGE)  /stringl/string2/ 

The  CHANGE  function  replaces  the  first  occurrence 
of  stringl  by  string2,  in  the  last  doublet  printed 
by  the  PRINT  command.   It  does  this  by  searching 
each  character  string,  belonging  to  the  doublet, 
for  an  occurrence  of  stringl.   The  first  character 
string  of  the  doublet  is  indicated  by  the  pointer 
set  by  the  PRINT  command  (See  PRINT  above).   When 
the  string  "stringl"  is  located,  it  is  replaced  by 
the  string  "string2".   If  stringl"  and  "string2" 
are  of  such  length  as  to  cause  the  new  string  to 
exceed  80  characters  (the  length  of  the  character 
strings  in  LISPTEXT),  an  error  message  will  be 
displayed.   (See  APPENDIX  A)  Note  that  "stringl" 
must  reside  in  only  one  character  string  of  LISPTEXT. 
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It  will  not  be  recognized  by  the  'C'  function  if 
part  resides  in  one  string  while  the  remainder 
resides  in  the  next  character  string  of  LISPTEXT. 
Because  of  an  implementation  restriction,  the  maximum 
length  of  "stringl"  is  35  characters. 

4.  RECOMPUTE 

R     (RECOMPUTE)     n 

The  command,  RECOMPUTE,  causes  an  S-expression 
doublet  "n"  to  be  fed  to  the  Interpreter  as  an 
input.   It  obtains  the  same  results  as  a  direct 
input  to  the  Interpreter. 

5.  LIST 

LIST  type 

The  LIST  command  tells  the  Editor  to  search  OBLIST 
and  print  the  names  of  all  items  stored  there  with 
the  characteristic  "type".   The  three  allowable 
"type"  designators  are 

A    (ATOM), 

F     (FUNCTION) , 

S     (SPECIAL  FORM). 
The  Editor  will  display  the  items  in  the  order  in 
which  they  appear  in  OBLIST,  along  with  any  indicators 
they  might  have  on  their  property  lists  (except 
PNAME  and  user  defined  indicators).   Since  these 
lists  can  be  long,  and  displaying  them  can  be  time 
consuming,  a  feature  has  been  incorporated  which 
allows  the  user  to  terminate  the  listing  process. 
After  20  names  are  displayed,  the  Editor  will  ask 
the  question  'CONTINUE?'  to  which  the  user  must 
answer  either  'Y'  or  'N'. 

6.  DELETE 

D     (DELETE)       name 

The  DELETE  command  results  in  a  search  of  OBLIST 
for  the  name  "name".   It  is  deleted  from  the  system 
when  it  is  found.   If  it  is  not  found  a  message  is 
printed  to  that  effect. 

The  discussion  of  the  Interpreter,  which  follows,  is  primarily 
concerned  with  two  items.   One  item  is  the  Garbage  Collector  and  the 
other  is  a  slight  modification  of  LISP  memory  necessitated  by  the  imple- 
mentation of  the  Garbage  Collector. 
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IV.   THE  INTERPRETER 

A.  GENERAL  DISCUSSION 

In  Section  IV  of  Reference  1,  Lieutenant  Gentry  made  several  recom- 
mendations for  improvement  of  the  NPS  LISP  interpreter.   The  primary 
concern  here  is  the  description  of  the  implementation  of  one  of  those 
recommendations,  the  Garbage  Collector.   The  Garbage  Collector  required 
a  slight  modification  of  the  NPS  LISP  memory  structure.   This  modifica- 
tion is  explained  in  the  next  subsection  in  coniunction  with  the  Garbage 
Collector. 

The  recommendations  for  future  expansion,  mentioned  above,  fell 
under  four  major  headings.   These  were,  Garbage  Collection,  Arithmetic 
Functions,  Functions  with  Functional  Arguments  and  the  Prog  Feature. 
The  final  three  of  these  recommendations  have  not  been  investigated  and 
therefore  remain  unimplemented. 

Besides  the  changes  which  will  be  discussed  in  the  next  subsection, 
an  error  recovery  routine  and  its  error  message  has  been  added.   This 
routine  is  called  when  the  user  uses  too  many  right  parenthesis  to  close 
the  first  S-expression  of  a  doublet.   (See  APPENDIX  A) 

B.  NPS  LISP  MEMORY  ORGANIZATION  AND  THE  GARBAGE  COLLECTOR 

The  previous  NPS  LISP  memory  structure,  discussed  in  Section  III. A. 6. 
of  Reference  I,  was  adequate  for  that  system's  needs.   As  long  as  there 
was  no  garbage  collector,  handling  LISP  storage  as  a  Linked  List,  (See 
Fig.  4(a))  the  previous  system  worked  very  well.   The  old  scheme  was 
to  store  numbers  from  the  "top"  of  memory,  working  down,   while  allocating 
"up"  for  List  structure.   This  sequential  allocation  scheme  is  not  compat- 
ible with  an  efficient  garbage  collector  (one  based  on  a  linked  allocation 
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scheme).   Consequently,  a  few  minor  alterations  were  made  to  change  the 
structure  to  that  shown  in  Figure  4.(b).   Up  to  the  time  the  user  acti- 
vates the  Garbage  Collector  for  the  first  time,  the  new  storage  scheme 
is  apparently  identical  to  the  old.   After  garbage  collection,  however, 
the  new  structure  becomes  evident,  with  list  structure  storage  linked 
and  number  storage  sequential. 

The  NPS  LISP  1.5  VERS  1  Garbage  Collector  is  relatively  simple  and 
was  built  as  part  of  the  Supervisor  (See  Section  II. C. 7.).   It  is  called 
explicitly  by  the  user  who  may  determine  the  necessity  of  garbage  col- 
lection by  using  the  Supervisor  command  COUNT$  (Section  I.C.6.).   Gentry 
recommended  a  warning  system  in  conjunction  with  this  (user  called) 
garbage  collector.   This  warning  system  would  periodically  count  the 

calls  in  free  storage  and  issue  a  warning  if  free  storage  became 

12 
"dangerously  close  to  becoming  empty."    This  warning  system  was  not 

incorporated  and  the  user  must  use  the  explicit  COUNT$  command  to  deter- 
mine how  much  free  storage  remains.   The  Garbage  Collector  is  called  by 
the  command  COLLECT$,  at  which  time  the  two  active  lists  are  traversed 
and  marked.   These  two  lists  are  (1)  the  OBLIST  and  (2)  the  ESTART  list. 
The  OBLIST  is  fully  described  in  Reference  1  (Section  III.A.5.).   It  is 
sufficient  to  note  that,  through  the  OBLIST,  the  Garbage  Collector  can 
get  to  every  active  atom  and  its  property  list. 

The  ESTART  list  is  a  list  used  by  the  Editor  and  is  made  up  of  pairs 
of  words.   The  CAR  of  the  first  word  is  an  S-expression  doublet  number, 
and  the  CAR  of  the  second  word  is  the  corresponding  character  string 
number  in  file  LISPTEXT.   Each  active  cell  is  marked  by  placing  a  '1' 
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Gentry,  p.  52, 
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OLD  LISP  STRUCTURE 
(a) 


NPS  LISP  1.5  VERS  1 

STRUCTURE 

(b) 
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collection) 
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Sequential 
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FIGURE  4 

IMPROVED  LISP  MEMORY  STRUCTURE 
SHOWING  OLD  AND  NEW  STRUCTURE 
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in  the  17th  bit  (which  is  otherwise  '0')-   The  Garbage  Collector  then 
starts  at  the  cell  sequentially  following  the  last  cell  in  OBLIST 
(FSTOR(127))  and  progresses  sequentially  through  LISP  storage  until 
reaching  NBASE  (the  base  of  the  number  storage  area).   Along  the  way, 
every  cell  is  checked  for  a  ' 1*  in  the  17th  bit.   If  it  is  marked,  it  is 
then  unmarked  (the  ' 1'  is  replaced  with  a  '0').   If  the  cell  is  unmarked 
it  is  linked  to  end  of  free  storage.   The  value  of  the  PL/I  variable 
FREE  is  unchanged,  but  the  value  of  EFSTOR  is  changed  to  the  address  of 
the  last  cell  linked  up.   The  Garbage  Collector  then  sets  BNUM  equal  to 
MFSTOR  (See  Fig.  4)  and  resequences  the  number  storage  area.   This  opera- 
tion of  collecting  in  the  number  storage  area  can  be  called  separately 
by  use  of  the  Supervisor  command  C0LLECTN$  (See  Section  II.C.7.(a)). 

The  final  section  of  this  thesis  is  a  brief  look  at  future  expan- 
sion possibilibies.   I  have  only  indicated  areas  of  possible  development, 
omitting  details. 
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V.   RECOMMENDATIONS  FOR  FUTURE  EXPANSION  OF  THE 
NPS  LISP  1 . 5  VERS  1  SYSTEM 


The  four  main  areas  for  expansion,  listed  by  Lieutenant  Gentry  in 
Reference  1,  were: 

1.  Garbage  Collection, 

2.  Arithmetic  Functions, 

3.  Functions  with  Functional  Arguments, 

4.  The  Prog  Feature. 

Of  these  four  main  areas,  only  the  Garbage  Collector  has  been  implemented 
The  others  were  expansions  of  the  Interpreter  specifically,  and  were  not 
attempted  in  the  development  of  the  VERS  1  system.   These  recommenda- 
tions remain  for  future  development,  since  the  expansion  of  the  arith- 
metic functions,  the  inclusion  of  the  ability  to  handle  the  PROG  feature 
and  functions  with  functional  arguments,  would  greatly  enhance  the 
capabilities  of  the  present  Interpreter. 

Although  the  Supervisor,  handles  the  special  dump  files,  it  does 
not  have  a  true  I/O  capability.   One  recommendation  would  be  that  the 
Supervisor  be  expanded  to  handle  user  defined  files,  I/O  to  tape  drives, 
and  output  to  a  print  file  for  use  with  the  printer.   The  Q-32  system 
has  extensive  I/O  capability.   This  system  could  be  studied  and  some 
of  its  features  perhaps  implemented  as  part  of  the  VERS  1  Supervisor. 
Another  helpful  feature  would  be  a  short  IBM  360  Assembler  Language 
routine  which  would  print  the  S-expression  doublet  number  instead  of 
the  standard  '_*  ,  which  follows  the  'CALL  EVALQUOTE,  ARGS : '  message. 
This  routine  would  be  called  each  time  the  first  line  of  a  new  doublet 
is  input. 
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The  present  Editor  provides  the  basic  functions  required  of  an 
editor.   However,  a  study  of  the  BBN  editor  is  sure  to  reveal  specific 
functions  which  would  be  profitable  if  implemented  on  the  NPS  LISP 
Editor.   One  example  is  the  multiple  change  feature.   If  present,  this 
function  would  locate  every  occurrence  (in  a  doublet)  of  the  string  to 
be  replaced,  and  replace  it  with  the  new  string. 

In  conclusion,  the  first  version  of  NPS  LISP  1.5,  (VERS  1),  meets 
all  the  basic  requirements  of  an  interactive  LISP  system  under  the  CP/ 
CMS  time-sharing  system.   Moreover,  its  structure  permits  easy  expansion. 
Therefore,  it  is  hoped,  future  versions  of  NPS  LISP  1.5  will  not  be 
restricted  by  any  design  feature  of  the  present  NPS  LISP  1.5  VERS  1. 
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APPENDIX  A 
NPS  LISP  1.5  VERS  1  ERROR  MESSAGES 

SUPERVISOR: 

SI :   COMMAND  NOT  RECOGNIZED,  TRY  AGAIN 

Special  option  request  is  not  recognizable. 
Check  Section  II. B  for  proper  format. 

System  Action:   Ignores  faulty  command  and  waits  for 
next  try. 

S2:   SUPERVISOR  COMMAND  NOT  RECOGNIZED 

A  regular  Supervisor  command  (one  ending  in  a  '$') 
was  not  recognizable.   Check  Section  II. C  for  proper 
format . 

System  Action:   Ignores  faulty  command  and  returns 
control  to  the  Interpreter. 

SA1. :  LINE  PARM  OUT  OF  BOUNDS 

AUTOSAVE  = 

The  line  parm,  n,  is  out  of  bounds  or  not  a  number. 
The  bounds  on  the  line  parm  are  li  ni  20. 

System  Action:   Ignores  the  faulty  line  parm  and  calls 
for  a  new  line  parm  input  by  displaying  'AUTOSAVE3' 
and  waiting  for  a  reply. 

SA?:  AUTOSAVE  DEFAULT  VALUE  ASSUMED 

The  second  line  parm  input  is  out  of  bounds  or  not  a 
number. 

System  Action:   Assumes  default  value  for  line  parm. 
Default  value  is  5. 

UNNUMBERED:   FILE  NOT  FOUND 

This  reply  to  a  L0AD$  file  name  command  indicates  file 
"filename"  is  not  on  the  user's  disk.   Check  for  in- 
correct spelling  of  "filename". 

System  Action:   Returns  control  to  the  Interpreter. 
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INTERPRETER: 

II:   PARENTHESES  ERROR 

There  are  too  many  right  parentheses  closing  the  first 
S-expression  of  the  doublet  being  input. 

System  Action:   Deletes  the  part  of  the  doublet  already 
input  and  sets  up  for  the  next  doublet  to  be  input. 

EDITOR: 

El:   EDIT  CALL  NOT  VALID,  TRY  AGAIN 

The  call  for  the  particular  Editor  function  desired  was 
not  recognized.   See  Section  III.B  for  proper  Editor 
calls. 

System  Action:   Editor  ignores  faulty  call  and  waits  for 
next  try. 

E2:   NO  S-EXPRESSION  ENTERED 

The  call  to  'PRINT  n'  or  'RECOMPUTE  n'  was  made  with  not 
onlv  doublet  "n"  not  in  the  system,  but  no  doublets 
entered.   Perhaps  a  LOAD$  command  was  not  issued  or  the 
"filename"  was  not  the  one  desired. 

System  Action:   Editor  ignores  call  and  waits  for  the 
next  one. 

E3:   S-EXPRESSION  NUMBER  NOT  FOUND 

The  call  to  'PRINT  n'  or  'RECOMPUTE  n'  was  made  with 
doublet  'n'  not  in  the  system.   Check  for  the  correct 


System  Action:   Editor  ignores  call,  waits  for  next  one, 
E3A:  FORMAT  ERROR:  PRINTING  S-EXP  NUMBER  "n" 

The  call  to  'PRINT  n,m'  was  incorrectly  formatted. 
Check  for  the  omission  of  a  comma  or  of  "m". 

System  Action:   Prints  doublet  "n". 

E4:   ILLEGAL  EDIT  COMMAND 

The  Editor  call  was  correct,  but  the  rest  of  the  call 
was  unrecognizable.   Check  for  incorrect  'CHANGE'  call 
format. 
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System  Action:   Editor  ignores  call  and  waits  for  the  next 
one. 

E5A:  'TYPE'  PARAMETER  MISSING 

On  a  'LIST  type'  call  the  "type"  parameter  was  left  off. 
Try  again. 

System  Action:   Editor  ignores  call  and  waits  the  next 
one. 

E5B:  'TYPE'  PARAMETER  NOT  RECOGNIZED 

On  a  'LIST  type'  call  the  "type"  parameter  was  not  a  legal 
one.   Check  Section  II. B. 5  for  legal  "type"  parameters. 

System  Action:   Editor  ignores  call  and  waits  for  next 
one. 

E6A:  FIELD  NOT  FOUND 

On  a  'CHANGE  /stringl/string2/ '  call  the  field  "stringl" 

was  not  found  in  the  doublet  pointed  to  by  the  "change" 

pointer.   This  pointer  is  set  by  the  'PRINT  n'  call. 
Check  Section  III.B.5  for  details. 

System  Action:   Editor  waits  for  next  call  leaving  the 
"change"  pointer  unmoved. 

E6B:  TRUNCATED 

On  a  'CHANGE  /stringl/string2/ '  call  the  field  "string2" 
is  longer  than  "stringl"  and  the  change  has  caused  the 
file  LISPTEXT  character  string,  which  now  contains 
"string2"  as  a  substring,  to  exceed  80  characters  in 
length.   The  excess  characters  have  been  dropped  on  the 
right. 

System  Action:   Editor  makes  the  change  truncating  on  the 
right  and  waits  for  next  call. 

E7:   ATOM  NOT  FOUND 

On  a  'DELETE  name"  call  the  atom  "name"  was  not  found  in  the 
system. 

System  Action:   The  Editor  waits  for  the  next  call. 

UNNUMBERED:     FIELD  TOO  LONG 

This  reply  to  a  'CHANGE  /stringl/string2/'  call  means  that 
the  field  of  "stringl"  exceeds  35  characters,  the  maximum 
field  length  for  "stringl". 

System  Action:  Editor  waits  for  next  call. 
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APPENDIX  B 


MAJOR  PL/I  BLOCKS  AND 
THEIR  FUNCTIONS 


MAJOR  BLOCK 


ENTRY  POINTS 
AND  LABELS 


LI  SPA 


SCNT: 
LOOP: 


LISPA  is  the  Supervisor. 
The  Special  Options  routine. 
The  basic  supervisor  toutine 
analogous  to  EVALQUOTE  in 
other  systems. 


TERM: 
CMD: 


The  exit  point  from  the  system. 

The  routines  following  this 
label  handle  the  Supervisor 

commands . 


TEXTWRK: 


A  function  called  by  several 
routines  but  used  primarily  by 
the  Editor.   It  stores  doublets 
in  LISPTEXT  and  reads  lines  of 
LISPTEXT  into  CARD  BUFFER. 


TSAVE: 


Copies  LISPTEXT  into  LISPTEMP. 


LISPB 


LISPB  contains  LISP  subroutine 
functions.   The  entry  point  names 
are  the  names  of  the  LISP  functions 
with  an  'N'  prefix. 


LISPC 


LISPC  contains  the  syntax  and  lexical 
analysis  functions.. 


NREAD: 


Reads  in  an  S-expression,  and  sets 
up  the  list  structure  required  by 
EVALQUOTE.   (It  manages  OB LIST  in  the 
process) . 


INCWRK: 


Handles  the  storing  of  input  lines 
in  LISPTEXT,  the  incrementing  of 
the  autosave  counter,  and  printback 
if  that  option  has  been  chosen. 


SCAN: 


The  entry  point  for  the  routine  that 
reads  in  a  line  and  carries  out  the 
lexical  analysis  of  that  line. 
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ENTER:     Enters  an  atom  into  OBLIST  after  HASH 
has  returned  the  atom's  OBLIST  number. 

HASH:      Hash  codes  atoms  to  obtain  their  OBLIST 
number. 


LOOKUP : 


Looks  to  see  whether  or  not  an 
atom  is  stored  in  OBLIST. 


LISPD: 


LISPD  is  the  Interpreter,  the  Print 
and  Trace  and  FSUBR  functions. 


LISPE: 
LISPF: 


LISPG 


READER: 


DUSAVE: 
LOADER: 

COLLECT : 


EA 


El: 

E2: 
E3: 
E4: 
E5: 


LISPE  is  the  initialization  routine. 

LISPF  contains  the  reader,  the  Garbage 
Collector  and  the  dump  and  load 
routines. 

The  read  routine.   It  displays  what- 
ever string  it  has  been  passed  and 
receives  the  input  into  whatever 
buffer  has  been  designated  by  the 
calling  routine  (usually  the  72 
character  string  BUFFER). 
The  dump  routine  for  LISP  memory. 
The  load  routine  for  files  AUTOLISP 
and  DUMPLISP. 
The  Garbage  Collector. 

LISPG  is  the  NPS  LISP  1.5  VERS  1 

Editor. 

The  routine  which  handles  I/O  with 

the  terminal,  and  analyzes  the  user 

input. 

The  PRINT  routine.   It  is  also  used 

by  the  RECOMPUTE  routine. 

The  LIST  routine. 

The  CHANGE  routine. 

The  DELETE  routine. 

The  RECOMPUTE  routine. 


LISPP: 


LISPP  contains  all  the  primitive 
LISP  functions.   These  correspond 
to  the  entry  point  names  without  the 
'N'  prefix. 
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APPENDIX  C 
LISTING  OF  THE  NPS  LISP  1.5  VERS  1   SYSTEM 


LISPA:    PROC    OPTIONSCMAIN)  ; 

/*    THIS    IS    THE    LISP    SUPERVISOR    */ 

DECLARE 

ACCUM    CHAROO)     EXT, 

ASCTR    BIN    FIXEO    EXT, 

ASNMBR    BIN    FIXEO    EXT, 

ASTAG    BITd)     EXT,       /*     'l'B:    AUTOSAVE    ENABLED    */ 

AVAR    CHAR(2)     VARYING, 

BNUM    BIN    FIXED    EXT, 

BP    BIN    FIXED    EXT, 

BUFFER    CHAR(72)     EXT, 

CARDNOl    BIN    «=IXED(31fO)    EXT, 

CARDN03    BIN    FIXED(31,0)    EXT, 

CH4    CHAR(4)  , 

COUNT    BIN    FIXED    EXT, 

CTAG    BIT(l)    EXT,       /*    'l'B:     INPUT    SI, LINE    1    */ 

DTAG    BIT(l)     FXT, 

EFSTOR  BIN  FIXED  EXT, 

1  FCB  EXT, 

2  COMMAND  CHAR(8)  , 

2  FILENAME  CHAR<8), 

2  FILFTYPE  CHAR(8)  , 

2  CARD  NUMBER  BIN  FIXEO(31,0), 

2  STATUS  BIN  FIXED(31.0) » 

2  CARD  BUFFER  CHAR<80), 
ENDTAG  BITd)  EXT,   /*  'l'B:  END  LISP  */ 

ERSTAG  BITd)  EXT,   /*  »1«B:  FILFS  A  LISP  OR  D_LISP  EXIST 
ERRTAG  BIT(l)  EXT,   /*  'l'B:  PAREN  El<RGR  */ 
ESTART  BIN  FIXED(31)  EXT, 
FREE  BIN  FIXED  EXT, 
FSEND  BIN  FIXED, 

FST0R(0:16000)  BIN  FIXFD(31)  EXT, 
LCOUNT  BIN  FIXED  EXT, 
MFSTOR  BIN  FIXEO  EXT, 
MODETAG  BITd)  EXT, 
NREAO  ENTRY  EXT, 
PTAG  BITd)  EXT, 

READER  ENTRY(CHAR(25)  VARYING, CHAR ( 72) )  RETURNS ( BITd )) , 
RTAG  BITd)  EXT, 

51  BIN  FIXED, 

52  BIN  FIXED, 

53  BIN  FIXED, 
TCOUNT  BIN  FtXED  EXT, 
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VARA  CHAR(25)  VARYING; 

VARA='SPECIAL  OPTIONS?1;  ESTART=0;  ERPTAG='0'B; 

PTAG,DTAG,ASTAG,ENDTAG,ERSTAG,RTAG=*0'B;  ASN*BR=5;  ASCTR=C; 

DTAG1='0'B; 

FILfcNAME='LISPTEXT» ;    F I LETYPE= ■ OAT  A' ;     COMMAND= » RDBUF*  ; 

CARD    NUMBER=l;    CALL    I HEFILE ( FCB) ; 

IF    SDBSTRCCARD    BUFFERtlfl)=,l»    THEN 

00;    C0MMAFJD=«  ERASE1;     CALL     IHEF  RE  (  FCB) ; 

COMMAND='WRBUF';  CARD  BUFFER='l'; 

CALL  IHFFILE(FCB) ;  GOTO  ST; 

END; 
IF  SUBSTR(CARD  BUFFER f 1,1 )=• 2 •  THEN 

DO;  DISPLAX'  •);  ERSTAG='1'B; 

DISPLAY(  '—FILES  LISPTEXT  AND  AUTOLISP  EXIST  —  •); 

DISPLAY( •  •) ;  GOTO  ST; 

END; 
IF  SUBSTRiCARD  BUFFER t 1 ,1 )=♦ 3 •  THEN 

DO;  DISPLA"Y<»  •);  ERSTAG  =  «1'B; 

DISPLAY(  '--FILES  LISPTEXT  AND  DUMPLISP  EXIST — •); 

DI SPLAY(  •  •)  ; 

END; 
ELSE  DO;  COMMAND= ' WRBUF • ;  CARD  BUPFER=,1«; 

CALL  IHEFILE (FCB) ; 

END; 
ST;  CARDN01=2; 

CALL  INITIAL; 
TC0UNT=2; 

IF  -.READERtVARA, BUFFER)  THEN  GOTO  TERM;  BP=0; 
SCNT;  CALL  SCAN;  IF  TCOUNT=0  THEN  GOTO  CK; 
SCNl;  IF  SUBSTR(ACCUMfl,COUNT)='N«  I  SU BSTR (ACCUM, 1, COUNT )= 'NONE* THEN 

DO;  DISPLAYC  •);  DISPLAYS  ');  GOTO  LOOP;  END; 
IF  SUBSTR(ACCUM,1 ,COUNT)='NP'  THEN  DO;  PTAG='0»8;  GOTO  CK;  END; 
IF  SUBSTR(ACCUM,1 ,1)=»P»  THEN  DO;  PTAG=,1,B;  GOTO  CK;  END; 
IF  SUBSTR(ACCUMfl , COUNT )=» AUTOS AVE'  THEN 

DO;  ASTAG=»1'B;  CALL  SCAN; 

IF  TCOUNT=0  THEN  GOTO  CK ; 

FILENAME=»LISPTEXT»;    CARD    BUFF£R=»2»; 

COMMAND='WRBUF« ;     CARD    NUMlFR=l;    CALL     IHEFILE I FCB  ) ; 

IF    SUBSTR(ACCUM,1  ,COUfiT)-.=  »  =  »    THEN    GOTO    SCNl; 

CALL  SCAN;  ASNMBR=SUBSTR(ACCUM,1,C0UNT); 

IF  ASNMBR>20  I  ASNMBR<1  THEN 

DO;  DISPLAY (»**SAl!  LINE  PARM  OUT  OF  BOUNDS**'); 
DISPLAY( •**AUTOSAVE=l )  REPLY(AVAR); 
ASNMBR=AVAR;  IF  ASNMBR>20  I  ASNMBR<1  THEN 
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CK 

LOOP 


TERM 


£X 


CMD 


MBR=5; 

(•**SA2;  AUTOS  AVE  DEFAULT  VALUE  ASSUMED** 

:  END; 


IF 


GOTO 

END; 

SU8ST" 

DO; 

FILE 

CARD 

FILE 

CALL 

END; 

DISPLAY!  • 

GOTO  SCNT 

IF  TCOUNT 

DISPLAY* • 

S1=NREAD; 


do;  ASN 
DISPLAY 

GOTO  CK 

END; 

CK; 

(ACCUM.l 

ASTAG='0 
NAME='  LI 

BUFFER* 
fiAME=' AU 

IHEFILE 

**S1  :  COMMAND  NOT  RECOGNIZED.  TRY  AGAIN**');  BP  =  1 


,COUNT)='NAS'    THEN 

•B;    ASN*BR=5; 

SPTEXT'; 

•1»;     COMMAND='WPBUF»  ;    CALL     IHEFUE(FCB); 

TOSAVE';     COMMAND='ERASE' ; 

(FCB) ;    GOTO    CK; 


=  2    THEN 


•) 

IF 


S2=NREAD; 

IF    S 

S3=NEVALO 
S3=NPRINT 
DISPLAY!  • 
GO  TO  LOO 
FILENAME= 
FILENAMF= 
CALL  TEXT 
COMMANDS' 
IF    SUBSTR 

DO; 
CARD  BUFF 
COMMA"ND=' 
DISPLAY* • 
RETURN; 
IF  ERRTAG 
IF    SUBSTR 

DO; 
IF    SUBSTR 
Cl:    DO; 


IF 
IF 


DIS 

SKO 

IF    S 

Sl=l 

S2<0 

IF    S 

2=127    TH 

(S1,S2)  ; 

(S3)  ; 

•) ;    D 
P; 

•AUTCLIS 
•LISPTEX 
WRK(I)  ; 
WRBUF' ; 
(CARD    BU 

call  The 
ER  =  'l'  ; 
FINUFD' ; 
EXIT    LIS 

THEN  DO 
(ACCUM,1 
TCOUNT=2 
(ACCUM.l 
IF    MOOET 

DO;  MOD 

CARDNOl 

END; 


GOTO  SCNT; 
PLAYC  •); 

THEN 
1=-1  THEN  GOTO  TERM;  ELSE  GOTO  CMD; 
27  THEN  GOTO  LOOP; 

THEN 
2=-l  THEN  GOTO  TERM;  ELSE  GOTO  CMD; 
EN  GOTO  LOOP; 


I  SPLAY  (• 


) ; 


P»;  COMMAND='ERASE' ;  CALL  THFFILE1FC 
T';  1=1;  RTAG='1'B; 
COMMAND='ERASE«  ;  CALL  IHEF  ILE  (  FCB)  ; 

FFER,1.1)=»3'  THEN 
FILE(FCB);  GOTO  FX;  END; 
CALL  IHEFILE(FCB); 

CALL  IHEFILE(FCB); 
P  SYSTEM'); 

;  errtag='0'B;  goto  ci;  END; 

,3)=»OPT'  THEN 

;  GOTO  SCNT;  END; 

♦1)=«Q»  THEN 

AG  THEN 

ETAG='0'B;    LCOUNT=LCOUNT-l; 

=CARDN03; 


B); 


48 


GOTO    LOOP; 
END? 
IF    SUBSTR(ACCUM,1  ,4)='DUMP«    THEN 
DO;     IF    ASTAG    THEN 

DO;    ASTAG='0'B;     FIL ENAME= • AUTOL ISP' ;     COMMAND= » ERA SE • ; 
CALL    IHEFILE(FCB) ; 
END; 
FILENAME='DUMPLISP';     COMMAND= • ERASE ■ ;     CALL     IHEF ILE ( FCB  ) ; 
DTAG='1'B;    ERSTAG='0'B; 
CALL    DUSAVE;    CALL    TSAVE; 
GOTO    LOOP; 
END; 
IF    SUBSTR(ACCUM,l,4)='LOAD'    THEN 
DO;    TCCUNT=2; 
AGN:    CALL    SCAN;    IF    TCOUNT=0    THEN    GOTO    LOOP; 
FILENAME=SUBSTR( ACCUM,1, COUNT) ;    CALL    OPEN; 
DISPLAY! 'LOADING    • I  I FI LENAME) ; 
IF    FILENAME='LISPTEXT«    THEN 

DO;    CALL    CLOSE;     FI LENAME= ' LISPTEMP' ;    CALL    OPEN; 

COMMAND='RDBUF' ;    CARD    NUMBER=U    CALL    IHEF  IL  E(  FCB  )  ; 

CH4=SUBSTR(CARD    BUFFER , 10 ,4 ) ; 

UNSPFC(ESTART)=UNSPEC(CH4) ; 

CH4=SUBSTR(CARD    BUFFER ,20,4) ; 

UNSPEC(FREE)=UNSPEC(CH4) ;     CH4=SUBSTR(CARD    BUFFER , 30,4)  ; 

UNSPEC(BNUM)=UNSPEC(CH4) ;    CH4=SUBSTR(CARD    BUFFER, 2, 4); 

UNSPEC(LC0UNT)=UNSPEC(CH4);    CH4=SUBSTP ( CAffD    BUFFER, 6, 4); 

UNSPEC<CARDN01)=UNSPEC(CH4); 

CH4=SUBSTR(CARD    BUFFER , 14,4) ; 

UNSPEC(EFST0R)=DNSPEC(CH4) ; 

CARD    NUMBER=2;    CALL    IHEF ILE ( FCB) ; 

DO    WRILE(STATUS-=12) ; 

FILENAME='LISPTEXT» ;    COMMAND=' WRBUF' :     CALL     IHEF ILE (FCB ) ; 

CARD    NUMBER=CAPD    NUMBER+1; 

FILEfiAME='LISPTEflP' ;    COMMAND= • RDBUF' ;     CALL     IHEF  ILE(  FCB  )  : 

END; 

COMMAND='ERASE' ;    CALL    IHEF ILE ( FCB) ;     /*    ERASE    LISPTEMP    */ 

CARD    NUMBER-l;     F IL ENAME=' L ISPTEXT ' ; 

IF    A5TAG    THEN    CARD    BUFFER='2';     ELSE 

CARD    BUFFER='l';    ER"STAG='0«:     COMMAND='  WRBUF'  ; 

CALL~IHEFILE(FCB);    GOTO    AGN; 

END; 
CALL    LOADER;    COMMAND=' ERASE' ;    CALL     IHEF ILE ( FCB) ;     GOTO    AGN; 
END; 
IF    SUBSTR(ACCUM,1 ,1)='E'    THEN 

DO;    CALL    EDITOR;    IF    ENDTAG   THEN    GOTO    TERM;     ELSE    GOTO    LOOP; 
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END; 
IF  SU3STR(ACCUM,li5)='  COUNT'  THcN 
DO;  FSEND=FSTOR<FREE> ;  1=0; 
DC  WHlLE(FSEND-.=0); 
FScND=FSTOR (FSEND);  1=1+1: 
E  NO  ; 
1=1+1: 

DI SPLAY(  'CELLS  IN  FREE  STORAGE:         ■ 
DISPLAY*  'CELLS  AVAILABLE  FOR  NUMBERS:' I 
GOTO  LOOP; 
END; 
IF  SIJBST«M  ACCUM,1  ,COUNT)  =  'COLLECTN'  THEM 
DO;  Dn  WHILE (BNUM<=MFSTOR) ; 

FSTOR(BNUM)=BNUM+l;  BNUM=BMUM+1; 
END:  8NUM=BNUM-1;  GOTO  LOOP; 
END; 
IF  SUBSTP ( ACCUM,1, 7) ='CCLLECT «  THEN 
DO;  CALL  COLLECT;  GOTO  LOO^; 
END; 


I  I); 

300-MFST0R  «-pr 


D1SPLAY1 '**S2 
GOTO    LOOP; 

TEXTfcRK:    ENTRY(LCl) ; 


SUPERVISOR    COMMAND    NOT    RECOGNIZED**'); 


DECLARE 

LCI    BIN    FIXED, 

NIL    BIN    FIXFD    EXT, 

NUMB    CHAR(3) , 

NUMB1    FIXED    DECIMAL: 

FILENAME='LISPTFXT«  ;    F I LETYPE  =  ' DAT  A' ; 
IF    ERSTAG     THEN 

DO;    COMMAND*  'ERASE';     CALL     IHEF  ILE ( FCB i ; 

CARD    NUMBER=1;     IF     ASTAG    THEN    CARD    BUFFFP='2'; 

""ELSE    CARD    BUFFER  =  'l'; 
COMMAND='WRBUFT;     CALL     IH £F IL E ( FC B ) ;     ERSTAO=«0'B; 
END; 
IF    RTAG    THEM 

DO;    CALL    OPEN;    COMMAND*  •  RDBU  F  '  ;     GOTO    READ:     END; 
IF    iCTAG    THEN    CARD    BUFFER*'  'MRUFFFR; 

ELSE    DO:     NUMBl=rCl;     NUMB=NUMB1;     CARDN03  =  C ARDNJ 1 ; 
IF    LCK10    THEN    DO; 

CARD_BUFFER  =  SU*STP< NUMB ,8,1  )!  |  •  •  I  I  "UFF 

GOTT    12;     END; 


CR 
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IF    LCK100    THEN    DO;    CARD    BUFFER=SUBSTR  (NUMB,  7,  2  )  I  I 
•  ■ I  I  BUFFER;       " 

GOTO    T2;    END; 
IF    LCKIOOO    THEN    CARD_BUFFER=SUBSTR(  NUMB,  6,  3  )  I  ! 
'  'IIBUFFER; 

END; 
T2:    COMMAND  =  'WRBUF« ;    CARD    NUMB£R  =  CAR DNOl ;    CALL     IHEF IL E ( FCB) ; 
IF    CTAG    THEN 

DO;     IF    LC1=1    THEN    ESTART=NCONS ( LCI , NCONS ( CARDNOl , N IL ) ) ; 
ELSE    ESTART  =  NCONS ( LCI , NCONS (CARDNOl , EST ART  )  ); 
END; 

CARDN01=CARDN01+1; 
RETURN; 
READ:    CARD_NUMBER=LC1 ;    CALL     IHEF ILE ( FCB) ;     CALL    CLOSE;    RETURN; 

OPEN:    ENTRY; 

COMMAND='STATE« ;    CALL    IHEFILE (FCB) ; 
COMMAND=« SETUP' ;    CALL     IHEFILE ( FCB) ; 

RETURN; 

CLOSE:    ENTRY; 

COMMAND=,FINIS» ;    CALL     IHEFILE (FCB) ; 
RETURN; 

TSAVE:    ENTRY; 

DCL    KT    BIN    FIXED    STATIC; 

1=1;    RTAG=I1,B;    CALL    TEXTWRK(I);    RTAG=,0»B; 

IF    DTAG    THEN    SUBSTR(CARD    BUFFER, 1 , 1 )=» 3» ;     CALL    CLOSE; 

COMMAND  =  'WRBUF»;    CALL     IHFFILE  (  FCB)  ;     COMMAND=«  FINU«=D' ; 

CALL    IHEFILE(FCB) ;    DTAG=»0'B;     KT=1; 

FILENAME=,LISPTEMP« ;    COMMANO= • ERASE • ;    CALL    IHEF ILE( FCB) ; 

RTAG=»1»B;  CALL  TEXTWRK(KT); 

DO  WHILE(KT<CARDN01) ; 

CARD_NUMBER=KT;    F I LENAME=» LISPTEMP* ;     C0MMAND= * WR BUF1 ; 

CALL    IHEFILE(FCB) ;    KT=KT+1;     CALL    TEXTWRK(KT); 
END; 

FILENAME=,LISPTEMP« ;    COMMAND= • FINUFD* ;    CALL    IHEF ILE (FCB) ; 
RTAG=»0«B;    FILENAME=,LISPTEXT»;    RETURN; 
END    LI  SPA; 
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LISPR:  PKOC; 


/*  LISP  SUBROUTINE  FUNCTIONS.  ENTRY  POINT  NAMES  CORRESPOND  T^ 
FUNCTION  NAMES  WITH  AN  •  N1  PPECEEDING  THEM.  */ 


Declare  ■ 

APVAL 
BFREE 
BNUM  B 
EXPR  B 
F  BIN 
FEXPR 
FLAG  B 
FREE  B 
FSTOR( 
FSUBR 
GB16  B 
GB32  B 
GT1  BI 
WFSTOR 
MUNE  B 
NIL  BI 
NC  BIN 
PNAME 
SUBR  B 
T  BIN 
TRACE 
TRCONS 


NCAaR  : 
NCAOR: 
NCDAR  : 
NCDDR  : 
NCAAaR 
NCAADR 
NCADAR 
NCDAAR 
NCADDR 
NCDADR 
NCDDAR 
NCDDDR 

NULL 


ENTRY(K 

ENTRY(K 

ENTRY(K 

ENTPYCK 

ENTRYf 

ENTRY( 

ENTRY( 

cNTRY( 

ENTRY( 

ENTRY( 

ENTRY( 

ENTRY ( 


PIN  F 
BIN  F 
I  N  FI 
IN  FI 
FIXED 
BIN  F 
IN  FI 
IN  FI 
0:150 
BIN  F 
IT(  16 
IT(32 
N    FIX 

BI  N 
IN    FI 
N    FIX 

EI  XE 
BIN  F 
IN  FI 
FIXED 
BIN  F 

BIN 

AA)  ; 
AD)  ; 
DA)  ; 
DD)  ; 

KAAA) 

KAAD) 
KADA) 
KDAA) 
KADD) 
KOAD) 
KDDA) 
KDDP) 


IX 

IX 
XE 

XE 

IX 

XE 

XE 

00 

IX 

) 

> 

FO 

FI 

XE 

ED 

r 

IX 
XE 

IX 
FI 


ED  F 
ED  E 
D  EX 
D  EX 
XT  I 
ED  E 
D  EX 
D  EX 
)  BI 
ED  E 
STAT 
STAT 

EXT 
XED 
0  fcX 

EXT 
EXT, 
ED  E 
D  EX 
XT  I 
FD  E 
XED 


XT, 

XT, 

T  INITIAL(-l), 

T, 

NITI AL(-l)  , 

XT, 

T, 

T, 

N  FIXEDOl)  EXT, 

XT, 

IC  ALIGNED, 

IC  ALIGNFD, 

EXT  INITIAL(-l)  t 
T  INTTIAL(-l), 
INITI AL(-l) , 

XT, 

T, 

NITI AL(-l) , 

XT, 

EXT; 


LIS 


DCL  KA 
PCL  KA 
DCL  KD 
DCL  KD 
:  DCL 
:  DCL 
;  DCL 
;  DCL 
;  DCL 
;  DCL 
;  DCL 
;  DCL 


RE 
RF 
RE 
RE 

KAAA; 

KAAD; 
KADA 

KDAA; 

KADD; 

KDAD; 

KDDA; 

KDDD; 


TUPN(NC 

TURN(NC 

TURN(NC 

TURN(NC 

RETURN 

RETURN 

;  RETUR 

RETURN 

RETURN 

RETURN 

RETURN 

RETURN 


AR(NC 
AR(NC 
DR(NC 
DR(NC 
(NCAR 
(NCAP 
NOMCA 
(NCDP 
(NCAP 
(NCDP 
(NCDP 
(NCDR 


AR(KAA)  )  ); 
OR(KAD) ) ); 
AR(KDA) ) ); 
DR(KDD) )  ); 
(NCAAR(KAAA)  )  ); 
(NCADR(KAAD)  )  ); 
R(NCDAR(KADA  )  )  ) 
(NCAAR (KDAA ) ) ) 
(NCDDR (KADD) ) ) 
(NCADR (KDAD) ) ) 
(NCDAR (KDDA) ) ) 
(NCDDR (KDDD)  )  ) 


ENTRY(NLL)  ; 
/*    RFTUPNS 
DCL    NLI 


T    IF    NLL    IS    THE    NULL    LIST,     F    OTHERWISE    */ 
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IF    NLL=NIL    THEN    RETURN(T); 
RETURN(F) ; 

NEQUAL:    ENTRY( JEQL ,KEQL)     RECURSIVE; 

/*    RETURNS    T    IF    J    AND    K    ARE   THE    SAME    S-EXPRESS ION 
AND    F    OTHERWISE       */ 
DCL    (JEQUKEQL); 
IF    NATOM(JEOL)=T    t    NATOM(KEQL )=T    THEN 

R6TURN(NEQ(  JEOL,KEOD); 
IF    NATCM(JEOL)=T     |    NATOM (KEOL )=T    THEN 

RETURN(F) ; 
IF    NEQUAL(NCARUEQL)  ,NCAP(KEQL)  )  =  T    THEN 

RETURN(NEQUAL(NCDR( JEQL), NCDR (KEOL) ) ); 
RETURN(F); 

NAPPEND:    ENTRY( JAPP , KAPP)     RECURSIVE; 

/*      APPENDS    LIST    KAPP    TO    END    OF    LIST    JAPP      -      VALUE    RETURNED 
IS    NEW    LIST      */ 
DCL    (JAPP, KAPP); 
IF    JAPP=NIL    THEN    RETURN( KAPP) ; 
RETURN(NCONS(NCAR(JAPP),NAPPEND(NCDR(JAPP),KAPP) )) ; 

NCOPY:ENTRY( JCOP)    RECURSIVE; 

/*      RETURNS    A    COPY    OF    LIST    JCOP       */ 
DCL    (  JCOP,MCOP,NCOP)  ; 
IF    JCOP=NtL    THEN    RETURN(NIL); 
IF    NATOM(JCOP)=T    THEN    RETURN( JCOP) ; 
MCOP=NCOPY(NCAR( JCOP) ); 
NCOP  =  NCOPY(NCDR( JCOP) )  ; 
RETURN(NCONS(MCOP,NCOP)) ; 

MEMBER:    ENTRY( JMEM, KM£M)     RECURSIVE; 

/*      RETURNS    T    IF    LIST    JMEM    IS    A    MEMBER    IF    LIST    KMEM, 
F    OTHERWISE       */ 
DCL     (JMEM.KMEM); 
IF    KMEM=NIL    THEN    RETURN(F); 

IF    NEQUAL( JMEM,NCAR(KMEM))=T    THEN    RETURN(T); 
RE  TURN (MEMBER (JMEM, NCDR (KMEM)  ) I; 

NPAIRLS:    ENTR Y( JPAIR , KPAI R,LPAIR)     RECURSIVE; 

/*      CREATES    A    LIST    OF    PAIRS    OF    CORRESPONDING    ELEMENTS    OF 
LISTS    JPAIR    AND    KPAIR    AND    PUTS    ON    FRONT    OF    LIST    LPAIR*/ 
DCL    ( JPAIR, KPAIR, LPAIR, M PAIR, NPAIR); 
IF    JPAIR=NIL    THEN    RETURN ( LPAIR ) ; 
MPAIR=NCONS(NCAR( JPAIR ),NCAR( KPAIR) I; 
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NP  A  I  R  =NP A  I R  L  S ( NCOR ( J  P  A I R ) , NC DK ( K P A  I R ) , L  P A  I P  )  : 
RETURN(NCONS( MPAIR,NPAIR)): 

NASSOC:    ENTPY( JAS,L*S)  ; 

/*       RETURNS    POINTER    TO    PAIR    ON    LIST    LAS     (A-LIST)    WHOSE 
FIRST    TPRM    =    JAS    */ 
DCL     ( JAS, LAS)  ; 
NASS:IF    NEQUAL(NCAAR(LAS) ,JAS)=T    THEN    R£TURN( NC AS ( L AS  )  ) 
LAS  =  NCDR(LAS)  ; 

IF    LAS=NIL    THEN    RETURN(NIL); 
GO    TE    MASS; 


NSUB2:    £NTRY( LSUB ,KSUR)     RECURSIVE 


/*       RETURNS    SECOND    TERM    OF    PAIR 
TERM    EQUAL    TO    KSUB       */ 
DCL     (LSUPfKSUB); 

IF     LSUB=NIL    THEN    RETURN( KSUB )  ; 
IF    NFQ(NCAAR (LSUB) , KSUB) =T    THEN 
RETURN(NSUB2(NCDP(LSUB) , KSUB)  >; 


ON    LIST    LSUB    HAVING    c  IP  ST 


RETURN(NCDAR (L^UR)  )  ; 


NSUBLIS 


£NTRY(LSBL,KSBL)     RECURSIVE; 
/*      RETURNS    AN    S-EXPRESSION       IN    WHICH    ALL    VARIABLES    IN 
S-EXP.     KSBL    HAVE    BEEN    REPLACED    BY    THE    VALUES    TO 
WHICH    THEY    ARE    CURRENTLY    BOUND    ON    THE    A-LIST     ( t  S  RL  ) 
DCL    (LSBL,KSBL) ; 

IF    NATCM(KSBL>=T    THEN    RETURN ( NSUB2 ( LS BL, K S BL )) ; 
RETURN(MCONS(  NSUBLIS  ( LS BL , NC AP ( KS RL  )  ) , 
NSUBLIS(LSBL,NCDR(KSBL) ) ) ); 

NSASSOC:    ENTR Y( JSAS , KSAS, LFN) ; 

/*      RETURNS    DOTTED    PAIR    FROM    LIST    KSAS    WHOSE    CAP     IS    EO 

TO    JSAS,     IF    NO    SUCH    PAIR    EXISTS,     RETURNS    THE 

FUNCTION    LFN       */ 

DCL  (JSAS, KSAS, LFN, MSAS) ; 

MSAS=KSAS; 
SAS:  IF  MSAS=NIL  THEN  RETURN(LFN); 

IF  MEQ(NCAAR(MSAS) ,JSAS)=T  THEN  RETURN( NC A" ( MS AS ) ) ; 

MSAS=NCDR(MSAS) ; 

GO  TO  SAS; 


NCONC:    ENTRYt  JNCKNC)     ; 

/*      RETURNS    LIST    JNC    WITH    LIST    KNC    ADDED    ON    TH    THE    FN D 
DCL    (JNCfKNCfMNCtNCONA); 
IF    JNC=NIL    THEN    RETURN (KNC ) ; 

MNC=JNC; 
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NCONMF    NCDR(MNC)=NIL    THEN 

DO;    NCONA=NRPLACD(MNC,KNC);    RETURN(JNC);     ENO; 
MNC=NCDR(MNC) ; 
GO   TC   nccn; 

NATTRIB:    ENTRY( JATR,KATR)  ; 

/*      ATTACHES    LIST    K    ONTO    END    OF    LIST    J    AND    RETURNS    K      */ 
DCL    ( JATR,KATR,N) ; 
N=NCONC( JATR,KATR)  ; 
RETURN(KATR)  ; 

NSUBST:    ENTRY* JST , KST .LSBST)    RECURSIVE; 

/*      RETURNS    LIST    FORMED    BY    SUBSTITUTING    JST    FOR    EVERY 
OCCURRENCE    OF    KST    IN    LSBST      */ 
DCL    (JST, KST, LSBST); 

IF    NEQUAL( KST, LSBST) =T    THEN    RETURN(JST); 
IF    NATOM(LSBST)=T    THEN    RETURN! LSBST  ) ; 
RE TURN( NCONS ( NSUBST (JST, KST, NC ARC LSBST)), 
NSUBST( JST, KST, NCDR( LSBST)) )); 

NPROP;    ENTRY    ( JPR  ,KPR, I PFN) ;  /*    11-12-69    */ 

/*    RETURNS    CDR    OF    CELL    WHOSE    CAP    IS    EO   TO    KPR     IF    ONE    EXISTS, 

RETURNS    THE    FUNCTION    IPFN    OTHERWISE    */ 

DCL    ( JPR, JPR1, KPR, IPFN)     FIXED    BIN; 

IF    NATOM(JPR)=T    THEN    JPR1=NCDR( JPR) ;    ELSE    JPR1=JPR; 
PROP:IF    JPR1=NIL    THEN    RETURN( IPFN ) ; 

IF    NEO(NCARUPRl)  ,KPR)=T    THEN    RETURN(  NCDR  ( JPR  1 )  )  ; 

JPR1=NCDR( JPR1)  ; 

GO    TC    PROP; 

NGET:    ENTRY( JGET,KGET) ;  /*    11-12-69    */ 

/*    RETURNS    CADR    OF    CELL    WHOSE    CAR     IS    EQUAL    TO   KGET    IF    ONE 
EXISTS,    RETURNS    NIL    OTHERWISE    */ 
DCL     ( JGET, JGET1,KGET,KGET1)     FIXEO    BIN; 
IF    NATOM( JGET)=T    THEN    JGET1=NCDR( JGET ) ; 
ELSE    JGET1=JGET; 
GETA:    IF    JGET1=NIL    THEN    PETURN(NIL); 

IF    NEO(NCAR(JGETl),KGET)=T    THEN    RETURN(NCADR ( JGET1 ) ) ; 

JGET1=NCDR(JGET1); 

GO   TO   GETA; 

NPAIR:  ENTRY( JPAR,KPAR)  ; 

/*   RETURNS  LIST  OF  DOTTED  PAIRS  OF  CORRESPONDING  ELEMENTS  OF 
LISTS  JPAR  AND  KPAR  WHICH  MUST  BE  OF  EQUAL  LENGTH   */ 
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DCL     <JPAR,KPAR,LPAR,MPARtNPAR); 
L  P  A  R  s  N I  L  ; 

MPAR=JPAR;    MPAR=KPAP; 
PAIRA:       IF    mpap=NIL     I     NPAP=NIL    THEN 
DO;        IF    mp£R=nil    THEN 

IF     NPAR=NIL    THEN    P ETUPN ( NRE VERS ( L R AR  )  )  ; 
RPTU»N(NIL)  ; 
END; 

LPAP=NCOMS(NCONS(NCAR(MPAR) , NCAR(NPAR) ), LPAR); 
MPAR  =  NCDP(MPAR) ;     NPAR=NCDR (NPAR  ); 
GO    TO    PAIRA; 


NUMR^RP:    ENTRY(NUMP)     ; 

/*      RETURNS    T    IF    MJMP    IS    AN    INTEGER    NUMBER 
DCL    NUMP; 
IF     NCDP(NUMP)>8NUM    THEN    RETURN(T); 

RETURN(F) ; 


F  OTHERWISE 


NEFFACE:  ENTRY( JEF,KFF)   ; 

/*    DELETES    ITEM    JEF    FROM    THE    TOP    LEVEL    OF    LIST    K=F    AND 
RETURNS    ALTERED    LIST    KEF       */ 
DCL    ( JEF, KEF,KEF1,EF1,EF2)     FIXFD    BIN; 
t<EFl=KFF; 
DO    WHILE    (NEQUAL( JEF,NCAR(KEF1)  )=T); 

KEF1=NCDP(KEF1) ;  END; 
EF2  =  KEF1;  EF1=NCDP(KEF1)  ; 
DO  WHILE  (EF1-.=  NIL); 

IF  NEQUAL(NCAR( EF1) , JEF)=T  THEN 

DO;   EF1=NCDR(EF1) ; 

£F2=NRPLACD(EF2,EF1); 

END; 

ELSE    DO;    EF2=EF1;    EFl=NCDP ( EF2 ) ;     END; 
END; 
RfcTURMKEFl)  ; 


LENGTH:    ENTRY(LGTH)     ; 

/*       RETURNS    LENGTH    OF    TOP 
DCL    (LGTH,KLG,NLG)  ; 
KLG=LGTH; 
MLG=0; 

DO    WHILE  (KLG-.=  NIL)  ; 
FSTOR(BNUM)=NLG? 
f*LG  =  NCCNS(  MONEtRNUM) 
BNUM=BNUM-1; 


LEVEL    OF    LIST    LGTH       */ 


NLG=MLG+1;     KLG=NCHR(KLG);     END; 


56 


RETURN(NLG); 

LAST:  ENTRY(JLST)  ; 

/*   RETURNS  THE  LAST  ITEM  ON  LIST  JLST   */ 
DCL  (JLST,KLST); 

KLST=JLST;   IF  JLST=NIL  THEN  RETURN(NIL); 
DO  WHILE(NCDR(KLST)^=NIL>;  KLST=NCDR (KLST ) ;  END; 
RETURN(KLST) ; 

NDEFINE:  ENTRY(LDEF)  RECURSIVE; 

/*   LDEF  IS  A  LIST  OF  PAIRS  OF  NAMES  AND  LAMBDA  EXPRESSIONS. 

NDEFINE  PUTS  AN  'EXPR*  INDICATOR  AND  THE  LAMBDA  EXPRESSION 
ON  THE  PROPERTY  LIST  FOR  EACH  NAME.   THE  VALUE  OF  NDFFINF 
IS  A  LIST  OF  NAMES  DEFINED  IN  THIS  WAY   */ 

DCL  (LDEF,KDEFT,LDEFT); 

IF  LDEF=NIL  THEN  RETURN(NIL); 

LDEF T=NPROP ( NCAAR( LDEF ),PNAME, NIL); 

KDEFT=NREMPRP(NCAAR(LDEF),EXPR); 

KDEFT=NCDR(LDEFT); 

KDEFT=NCONS(NCAR(NCD ARC LDEF) ),KDEFT); 

KDEFT=MCONS(EXPR,KDEFTI; 

KDEFT=NRPLACD(LDEFT, KDEFT) ; 

RETURN(NCONS(NCAAR(LDEF) ,NDEF INE ( NCDR(LDEF) )| ); 

NDEFLST:    ENTR Y( NDEF ,NI ND)     RECURSIVE; 

/*      THIS    FUNCTIONS    WORKS    JUST    LIKE    NDEFINE    EXCEPT    THE    INDICATOR 
•NIND'    SUPPLIED   AS    AN    ARGUMENT    IS    PUT    ON    THE    PROPERTY    LIST 
RATHER    THAN    «EXPR«.       VALUE    IS    A    LIST    OF    NAMES    DEFINED      */ 

DCL    (NDEF, NIND, MDEFT , NDEFT)  ; 

IF    NDEF=NIL    THEN    RETURN(NIL); 

NDEF T=NPROP(NCAAR( NDEF), PNAME,  NIL); 

MDEFT=NREMPRP(NCAAR( NDEF), NIND); 

MDEFT=NCDR(NDEFT); 

MDEFT=NCONS(NCAR(NCDAR(NDEF) ), MDEFT); 

MDEFT=NCONS( NIND, MDEFT); 

MDEFT=NRPLACD(NDEFT, MDEFT) ; 

RETURN! NCONS(NCAAR< NDEF) , NDEFLST ( NCDR (NDEF ), N IND) )); 

NREVERS:    ENTRY( LSTRU) ; 

/*   RETURNS    THE    REVERSE    OF    THE    TOP    LEVEL    OF    LIST    LSTRU    */ 
DCL    (LSTRU, LSTRV); 
LSTRV=NIL; 
AREV:IF    LSTPU=NIL    THEN    RETURN(LSTRV) ; 


57 


LSTRV=NCONS(NCAR(LSTRU),LSTRV)  ; 
LSTRU  =  N'COR(LSTRU)  ;    GO    TO    AREV; 

NREMPRP:    ENTRY( NPV,NRVP)     ; 

/*      DELETES    ALL    OCCURRENCES    OF    INDICATOR    AND    RELATED 
PROPERTY    FROM    PROP.    LIST    OF    ATOM    NRM    */ 

DCL     (NRw,NRMPfNRMPl,  NRM2H 

NRNP1=NRV; 

DO    WHILE     (NCDR(NRMP1  )^.=NIL>  ; 

IP    NEO(NCADR(NPMPl),NRMP)=T    THEN 

NRM2=NRPLACD(NPMP1,NCDDDR(NRMP1) ); 

ELSE    NRMP1=NCDR(NRMP1) : 
END; 
RETURN(NIL) ; 

NFLAG:    ENTR Y( FLST ,F I D ) ; 

/*    PUTS    THE    <=LAG    INDICATOR     'FID'     ON    THE    PROPERTY    LIST 
OF    EACH    ATOMIC    SYMBOL    ON    LIST     «FLST«     IMMEDIATELY 
FOLLOWING    THE     ATOM    HEADER       */ 

DCL    (FLST, FID, FLST1,FLST2)     FIXED    BIN; 
FLST1=FLST; 
NFLG:IF    FLST1=NIL    THEN    RETURN(NIL); 

FLST2=MRPLACD(NCAR(FLST1),MC0NS(FID,NCDAR(FLST1) ) ) ; 
FLST1=NCDP(FLST1) ; 
GO    TO    NFLG; 

NREMFLG:  ENTRY( RMFG , R ID) ; 

/*    REMOVES    £LL    OCCURRENCES    OF    FLAG    »RID«     FROM    THE    PROPERTY 
LIST    OF    ALL    ATOMIC    SYMBOLS    ON    LIST     'RMFG      */ 
DCL     (RMFG, RID, RMFG1 , RMFG2 , NFG )     FIXED    BIN; 
RMFG1=PMFG; 

DO    WHILE     (PMFG1-.  =  NIL)  ; 
RMFG2=NCAR(RMFG1)  ; 
DO    WHILE     (NCDR(RMFG2)-.=  NIL); 

IF    NEO(NCADR (RMFG2 ) , R I D) =T    THEN 

NFG=NRPLACD(RMFG2,NCDDR(RMFG2) ); 
ELSE    RMFG2=NCDR(RMFG2); 
END; 

RMFG1=NCDR(RMFG1)  ; 
END; 
RETUPN(NIL) ; 

NOT:    ENTRY(NOTARG) ; 

/*    RETURNS    F    IF    NOTARG    IS    TRUE,    OTHERWISE    RETURNS    T    */ 
DCL    NOTARG; 
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IF  NOTARG=F  I  NOTARG=NIL  THEN  RETURN(T); 
RETURN(F1 ; 

NTRACE:    ENTRY(TRLST) ; 

/*    PUTS    TRACE    INDICATOR    ('FLAG1)    ON    THE    PROPERTY    LIST 

OF    EACH    ATOMIC    SYMBOL    IN    LIST    TRLST    */ 
DCL    TRLST    FIXED    BIN; 
RE TURN (NFLAG( TRLST, FLAG)  I; 

NUNTRCE:    ENTRY(UTRL); 

/*   REMOVES    TRACE    INDICATORS    PLACED    BY    FUNCTION    TRACE    */ 
DCL    UTRL    FIXED    BIN; 
RETURN(NREMFLG(UTRL,FLAG))  ; 

NADDl:    ENTRY(NADl); 

/*   ADDS    ONE    TO    THE    VALUE    REPRESENTED    BY    NAD1    */ 
DCL    (NADltNAD2); 

FSTOR(BNUM)=FSTOR(NCDR(NADl))-H; 
NAD2=NCCNS(MONE,BNUM); 
BNUM=BNUM-1; 
RETURNCNAD2) ; 

NSUB1:    ENTRY(NSBl) ; 

/*    SUBTRACTS    ONE    FROM   THE    VALUE    REPRESENTED    BY    NSB1   */ 
DCL    (NSB1,NSB2); 

FSTOR(BNUMJ=FSTOR(NCDR(NSBl) 1-1; 
NSB2=NCONS(MONE,BNUMI ; 
BNUM=BNUM-1; 
RETURN(NSB2) ; 

END    LISPB; 
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lispc:  prcc; 

/*  lispc:   syntax  £  lexical  analysis  */ 

nrcad:  entry  bin  fixed; 

/*  this  procedure   is  called  once   pep  s-exfr ess  i  on.   it  returns  the 
pointer  to  the  s-exppessign  tree  it  has   built.   it  returns  a 
"-1"  on  an  "end  lisp"   input,   and  a  "-2"  when   it  scans   a  supepv 
command,    i.e.    one  which  encs   in  a  »f".  */ 


DECLARE 
ACCUM  CHA 
ASCTR  BIN 
ASTAG  BIT 
BNUM  BIN 
BP  BIN  FI 
BUFFER  CH 
8UFFN0  BI 
CADD  BIN 
COUNT  BIN 
CTAG  BIT< 
CTP  BIN  F 
OOTTAG  BI 
ERRTAG  BI 
1  FCB  EXT 


R(30)  EXTERNAL, 

FIXED  EXT, 
(1)  EXT, 
FIXED  EXT, 
XEO  EXTERNAL, 
AP(72)  EXTERNAL, 
N  FIXED  EXTERNAL, 
FIXED  EXTERNAL, 

FIXED  EXTERNAL, 
1)  EXT, 

IXED  EXTERNAL, 
T(l)  STATIC  ALIGNED, 
T(l)  EXT, 


CO 
FI 
FI 
CA 
ST 
CA 

I  NT AG  BIT 
JJ  BIN  FI 
LDIG  FIXE 
LCOUNT  BI 
LINE  BIN 
MODE  BIN 
MODETAG  B 
MONE  BIN 
NT  WO  BIN 
NIL  BIN  F 
N127  BIN 
PLEV  BIN 
POSIT  BIN 


MMAN 
LENA 
LETY 
RD  N 
ATTJS 
RD  B 
(IT 
XED 
D  BI 
N  FI 
FIXE 
FIXE 
IT(1 
FIXE 
FIXE 
IXED 
FIXE 
FIXE 
FIX 


D  CH 
ME  C 
PE  C 
UMBE 
BIN 
UFFE 
EXT, 
EXT, 
N(31 
XED 
D  EX 


AR(8)  , 

HAR(B)  , 
HAR(8)  , 
R    BIN    FIXED(31,0) 

FIXFD(31,0)  , 
R    CHAR(80)  , 


)     STATIC, 

EXT, 

TERNAL, 
D    EXT, 
)     EXT, 

C    INITIAL(-l)    EXT, 
D    INITIAH-2)     EXT, 

EXTERNAL, 
D  STATIC, 
D  EXTERNAL, 
ED(31)  EXTERNAL, 
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PTAG  8IT(1)  EXT, 

RESULT  BIN  FIXED  EXTERNAL, 

RE1TAG  BIT(l)  EXT, 

SEXP  BIN  FIXED  EXTERNAL, 

STAC(200)  BIN  FIXED(31)  EXTERNAL, 

STKTAB  BIT(l)  EXTERNAL, 

SWTCH(l:3)  LABEL( ATM, DIG, SPEC) 

INITIAL( ATM, DIG, SPEC), 
T  BIN  FIXED  EXTERNAL, 
TCOUNT  BIN  FIXED  EXTERNAL, 
VARC  CHAR(25)  VARYING; 

N127-127;  DOTTAG=«0«B; 
IF  -STKTAB  THEN 

DO;  bp=o;  JJ=-l;  buffno=buffno+i; 

END; 
ELSE  DO;  IF  -MODETAG  THEN 

DO;  TCOUNT=0;  IF  -RE1TAG  THEN  BP=72;  CTAG=»1»B; 
END; 

ELSE  TC0UNT=1; 
CTR=200;  SEXP,PLEV=0;  JJ=1; 
END; 
CONT:  CALL  SCAN; 

IF  RESULT=0  THEN  RETURN(MONE) ;   /*  » END  LISP*  WAS  INPUT  */ 
IF  SUBSTR(ACCUM, COUNT, 1)=«$«  THEN  RETURNCMTWO  ) ; 
IF  STKTAB  f.  INTAG  THEN  DO;  CALL  INCWRK;  INTAG=»0»B;  ENO; 
GOTO  SWTCH(RESULT) ; 
ATM:  CALL  HASH;   /*  HASH  CODE  */ 
IF  -.STKTAB  THEN 

DO;  IF  BUFFN0=2  I  BUFFNO=3  THEN 

DO;  L=LINE;  CALL  INIT1CL);  END; 
GOTO  IN; 
END; 
IF  JJ<0  THEN 
IN:  DO:  CALL  ENTER* POSIT) ;  JJ  =  1 ;  IF  STKTAB  THEN 

DO;  L=NEVAL2;  IF  L<0  THEN  RETURNCSEXP ) ;  END; 
ELS.E  DO;  L  =  LINE;  LINE  =  LINE+1; 
IF  BUFFNO>4  THEN 

IF  BUFFNO  =  13  THEN  CALL  INITL3R); 
ELSE  CALL  INITL2CL); 
ELSE  CALL  INITL(L); 
END; 
GOTO  CONT; 
END; 
JJ=LOCKUP( POSIT) ;  IF  JJ<0  THEN  GOTO  IN; 
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ELSE    DO;     IF    STKTAB    THEN 

DO:    L*NEVAL2;    IF    L<0    THEN    RETURN (SEXP ) ;     END; 
GOTO   CCNT; 
END; 
DIG:       LDIG=SU8STP( ACCUM,1, COUNT) ; 
IF    M0DE=7    THEN    LDIG=-LDIG; 
FSTOR(BNIJM)  =LHIG;    CADD=NCONS  (  MONE,  BNUMJ ; 
BNUM=BNUM-1:    FSTOR  !  BNUM)=0 ; 
L=NSTACK(CAPn) ;    GOTO    CONT ; 
SPcC:    IF    M0DE=6    THEN    DO;    PLEV=PLEV+1;    GOTO    CNT;     END; 
IF    M0DE=4    THEN    DC;    L  =  l ;    RETURN(L);     END; 
IF    M0DE=16    THEN    GOTO    CONT; 
IF    M0DE=7    THEN 

DO;    PLEV=PLEV-1; 
IF    PLEV<0    THEN 

DC;    DISPLAY!  «*U:    PARENTHESES    ERROR**); 
EPRTAG=»1»B;     RETURN ( MTWO ) ; 
END; 
IF    NEVAL3<0    THEN    PETURN( SEXP ) ;    GOTO    CONT; 
END; 
IF    MODE=2    TH^N    DO;    DOTTAG='l»B;     GOTO    CNT;     END; 
DISPLAY! 'ILLEGAL    SPECIAL    CHARACTER     IN    S-EXPRESS  ION •  ) ; 
RETURN(Ni27)  ; 
CNT:    L=NSTACK( VODE) ;    GOTO    CONT; 

EVALl:    ENTRY; 
/*    EVALUATES    AN    ATCV    S-EXPRESSION    */ 

MCDETAG  =  -.MODETAG;     L  =  NUNSTK;    SEXP=L; 
RETURN; 


NEVAL2:    ENTRY    BIN    FIXED: 
L=NSTACK(CADD)  ; 
IF    L=200    THEN 

DO:    CALL    EVALl;    RETURN! MONE) ; 
RETURN! SEXP) ; 


END; 


NEVAL3:    ENTRY    BIN    FIXED; 
/*    CALLED    UPON    SCANNING    A     •)'.    RETURNS    A    M-l»    ON    PLFV=0.    */ 
IF    DOTTAG    THEN    GOTO    DOTT; 
L1=NUNSTK; 

IF    Ll=6    THEN         /*    NIL    LIST:     !)    */ 
DO;    L1=NIL; 
L=NSTACK!L1) ;     IF    PLEV=0    THEN 

DC;    MODETAG=-.MODETAG:    SEXP=L1;     RETURN!MONE)  : 
RETURN(Ll) ; 


ENO; 
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END; 
IF    Ll=2    THEN    GOTO    CH; 
SEXP=NCONS(LlfNIL)  ; 
CH:    DO    WHILECU'B);    L1=NUNSTK; 
IF    Ll=6    THEN 

DO;    IF    PLEV=0    THEN 

DO;     MODETAG=-.MODETAG;    R  ETURN(  MONE) ;     END; 

L1=NSTACK(SEXP) ;     RETURN(Ll); 

END; 
SEXP=NCONS<Ll,SEXP) ; 
END; 
DOTT:    L1=NUNSTK;    L2=NUNSTK; 
IF    L2-=2    THEN 

DO;    DOTTAG='0'B;    GOTO   CH;    END; 
L=NUNSTK;     SEXP=NCONS(L»Ll) ; 
L1=NUNSTK;    IF    PLEV=0    THEN 

DO;    MODETAG=-.MODETAG;    RETURN* MONE) ;    END; 
L1=NUNSTK;    L=NSTACK(L1) ; 
IF    Ll=2    THEN    DOTTAG=,l,B; 
ELSE    DOTTAG=«0*B; 
L1=NSTACK(SEXP) ;    RETURN(Ll); 

NSTACK:    ENTRY(J3)    PIN    FIXED; 
DECLARE 
J3    BIN    FIXED, 
LI    BIN    FIXED; 

STAC(CTR)=J3;    L1=CTR;    CTR=CTR-1;    RETURN(Ll); 

NUNSTK:  ENTRY  BIN  FIXED; 

DECLARE 

J4  BIN  FIXED; 

CTR=CTR+1;  J4=STAC(CTR);  STAC(CTR)=0;  RETURNCJ4); 

INCWRK:  ENTRY; 

IF  RE1TAG  THEN  GOTO  JP1; 

CALL  TFXTWRK(LCOUNT) ; 
IF  ASTAG  £  CTAG  THEN  ASCTR  =  ASCTR«-1; 
IF  CTAG  THEN  LCOUNT=LCOUNT*l ; 
JPl:  IF  PTAG  THEN 

DO;    DISPLAYC     •); 

IF    -CTAG    THEN    DISPLAYC  'If  BUFFER); 
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ELSE  DISPLAY(LC0UNT-1 | | •   'IIBUFFER); 

END; 
CTAG=«0'B; 
RETURN; 

HASH:  ENTRY;  . 

POSIT=MOD(UNSPEC(SUBSTR(ACCUM, 1t3) J+CCUNT* 

16777214, N127)-H  ; 
RETURN; 

/*  LEXICAL  ANALYSIS  PHASE  */ 

SCAN:  ENTRY; 

DECLARE 

ALPBAS5  BIN  FIXED  EXTEPNALt 

CHARSET  CHAR(52)  EXTERNAL, 

DIGBASE  BIN  FIXED  EXTERNAL, 

FF  BIN  FI XED  STATIC, 

KK  BIN  FI XED  STATIC, 

NO  BIN  FI XED, 

NUMBERSW(0:3)    LABEL    (  SCANMANT  ,  SC  ANFRACSCANEXSN,  SCANE  X) 

INITIAL    (  SC  ANMANT,SC  ANFRACSCANEXSN,  SCANE  X)  , 
PNAME    RTN    FIXED    EXTERNAL, 

READER    ENTRY(CHAR(25)     VARYING, CHAR ( 72) )    RETURNS < 81 T ( 1  )) , 
SWITCH(0:3)     LABEL    ( DEBLANK, IDENT , DIGIT ,QNUMBER ) 

INITIAL     (DEBLANK,  I  DENT  ,  DI  GIT,  QNIJMBER  ) , 
TT    CHAR(l)     STATIC; 

RESULT, COUNT, FF,MODE=0; 

ACCUM=«     •; 

DO    WHILEf  '1  'B)  ; 

IF  BP=72  £  TCCUNT=2  THEN  DO;  TCOUNT=0;  RETURN;  END; 

BP=BP+l; 

IF  BP>72  THEM 

DO;     IF    RE1TAG    THEN 

DO;    CALL    GBUFF;     BUFFER =SU BSTR ( CARD    BUFFER, 9 , 72 ) ; 
GOTO    JP; 
END; 
IF    CTAG    THEN    VARC='CALL    EVALOUOTE,     ARGS:»; 
ELSE    VARC=«     •;     IF    -.READ6R(V ARC,  BUFFER  >    THEN 
DO;    RcSULT=0;    RETURN;     END; 
JP:    BP=1;     INTAG='1'8; 
END; 
TT=SUBSTR(BUFFER,BP,1) ;    KK= INDEX ( CHARSET, TT I : 
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GOTO  SWITCH(RESULT) ; 
OEBLANK:  IF  KK>1  THEN 

IF  KK>ALPBASE  THEN 

IF  KK>DIGBASE  THEN  RESULT=2; 
ELSE  RESULT=1; 
ELSE  IF  KK=7  |  KK=8  THEN    /*  +-.*/ 
DO;  RESULT=3;  MODE=KK; 
END: 

ELSE    /*  SPECIAL  CHARACTER*/ 
DC;  MODE=KK;  COUNT=l;  SUBSTRC ACCUM, 1, 1 )=TT; 
RESULT=3;  GOTO  RETURNL; 
END; 
ELSE  GOTO  XIT; 
GOTO  STCRET; 
IDENT:  IF  KK>ALPBASF  THEN  GOTO  STORET; 
IF  KK=3  THEN  GOTO  STORET; 
GOTO  BACKUP; 
DIGIT:  GOTO  NUMBERSW( FF ) ; 
SCANMANT:  IF  KK>DIGBASE  THEN  GOTO  STORET; 
IF  KK=2  THEN    /*  DECIMAL  POINT  */ 
DO;  mode=1;  ff=1: 
GOTO  STOPET; 
END; 
ELSE  GOTO  CHECKEXP; 
SCANFRAC:  IF  KK>DIGBASE  THEN  GOTO  STORET; 
CHECKEXP:  IF  TT=»EI  THEN 

DO:  FF=2;  MODE=l; 
GOTO  STORET; 
END; 
GOTO  BACKUP: 
SCANEXSN:  IF  KK=7  I  KK=8  THEN 
DO;  FF=3;  GOTO  STORET; 
END; 
IF  KK>DIGBASE  THEN 

DO;  FF=3;  GOTO  STORET; 
END; 
GOTO  BACKUP; 
SCANEX:  IF  KK>DIGBASE  THEN  GOTO  STORET; 

GOTO  BACKUP; 
ONUMBER:  IF  KK>DIGBASE  THEN 
DO;  RESULT=2; 
IF  MODE=5  THEN 

DO;  MODE=l;  FF=1; 
END; 
ELSE  MODE=0; 
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STCRET: 


X I  T  : 

BACKUP: 
«ETURNL 


GOTO    S TO PET; 

END: 
GOTO    BACKUP; 

IF    CGUMT>30    THEN    GCTO    RETURNL ; 
CCUNT  =  CCUNT+1  ; 
SUBSTR(ACCUM,CGUNT,1)=TT; 
END; 

BP=BP-l; 
RETURN; 


ENTER:    ENTRY( Jl) : 

/*  THIS  PROCEDURE  RECEIVES  THE  LOCATION  IN  OBLIST  OF  AN  A TO^ 
THEN  SETS  UP  THE  ATOM  WITH  ITS  PRINT  NAME  STRING,  SETTING 
THE    ADDRESS    OP    ITS    HEADER    CELL    TO    THE    EXTERNAL    VARIABLE    •  C 

DECLARE 

FSTOR(0:16000)    BIN    FIXEDOI)     EXT, 

Jl    BIN    FIXED, 

LB32    BIT(32)     ALIGNED, 

^COUNT    BIN    FIXED, 

FN    BIN    FlXtT, 

TE    BIN    FIXED, 

TW016    FIXED    BIN    (311     STATIC    I NI T I AL ( 65536 ) ; 

FSTOR(  Jl)  =FSTCR(J1)+TWC16: 
L=NIL;     VCOUKT=CCUNT-l; 
DO    1=0    TC    MCCUNT; 

K=COUNT-I ;    TE=UNSPEC(SUBST5 (ACCUM,K,1I ); 

L=NCCNS(TE,L) ; 
END: 

PN  =  NCONS( NCONS( MONF, NCCNS < PNAME , NCONS ( L , N IL )  )  ),NIL  ); 
CADD  =  NCAR(PN)  ;    /*    CADD=ADDRESS    OF    THF    ATOM    HEADFP    CELL 
IF    NCAR<J1)=1     THEM    L=NRPL ACD( Jl , PN ) ; 
ELSE    DO; 

L=NCDR( Jl) ; 

DO  WHILE  (NCDR(L)-.=NIL)  ;  L=NCDR(L);  END; 

K=NRPLACD(L,PN) ; 

END; 
RETURN; 

LOOKUP:  ENTPY(J2)  BIN  FIXED; 

/*  THIS  PROCEDURE  RECEIVES  A  LOCATION  IN  OBLIST  AND  THEN  LOOK 
THE  ATOMS  STRUNG  FROM  THAT  LOCATION.  IF  IT  FINDS  A  MATCH  W 


AMD 
ADD1.. 


*/ 


S  AT 

ITh 
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THE  ATOM  STORED  IN  ACCUM  THEN  IT  RETURNS  A  "1",  SETTING  CADO 
EQUAL  TO  THE  ATOM  HEADER  CELL,  ELSE  IT  RETURNS  A  "-1".   */ 

DECLARE 

CP1  CHAR(l) , 

CP2  CHAR(l) , 

II  BIN  FI XED  STATIC, 

J2  BIN  FIXED, 

TE1  BIN  FIXED; 

NO=NCAR( J2) ? 

IF  NO=0  THEN  RETURN(MONE) ; 

TE1=NCDR< J2) ; 

DO  11=1  TC  NO; 

TE=NCAR(TE1)  ; 

LL  =  NGET(TE,PNAME)  ; 

KK=1  * 

DO  WHILE  (KK<=COUNT) ; 

C PI =SUBSTR< ACCUM, KK,l); 

UNSPEC(CP2)=SUBSTR(UNSPEC(FSTOR(LL) ),9,8); 
IF  CP1-=CP2  THEN  GO  TO  LOOKA; 
KK  =  KK-H;  LL  =  NCDR(LL); 
IF  LL=NIL  THEN  GO  TO  LOOKA; 
END; 
LOOKA:    IF  KK=COUNT*l  THEN 

DO;  CADD=TE;  TE=1;  RETURN(TE);  END; 
TE1=NCDR(TE1) ; 
END; 
RETURN( MCNE) ; 


END  LISPC; 
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/*  LISPD:  INTERPRETER, PRINT  L    TRACE,  AND  FSURR  FUNCTIONS  */ 


NEVALQ:  PROC ( FNEVQ  ,  AE VQ) ; 


DECLARE 
APPLY  B 
APVAL  B 
AEVO  BI 
BFREE  B 
BLANK  B 
BUFFCON 
CAPPLY 
CEVAL  C 
CEVALQU 
CEVCON 
CEVLIS 
COMMA  B 
CCND  BI 
DASH  BI 
DCLLAR 
EIGHT  B 
EOSIGN 
ERFLAG 
EVAL  BI 
EVCON  B 
EVLIS  B 
EXPR  BI 
F  BIN  F 
FEXPR  B 
FIVE  BI 
FLAG  BI 
FNEVO  B 
FNCTION 
FOUR  BI 
FSTOR(0 
FSUBR  B 
FUNARG 
LABEL  B 
LAMBDA 
LAST  EN 
LENGTH 
LPAR  81 
NBLKS  B 
NIL  BIN 
NINE  BI 


IN  FIX 
IN  FIX 
N  FIXE 
IN  FIX 
IN  FIX 

BIN  F 
CHAR(5 
HAR(M 
OTE  CH 
CHAR(? 
CHAR(5 
IN  FIX 
N  FIXE 
N  FIXE 
BIN  FI 
IN  FIX 
BIN  FI 
BIN  FI 
N  FIXE 
IN  FIX 
IN  FIX 
N  FIXE 
IXED  E 
IN  FIX 
N  FIXE 
N  FIXE 
IN  FIX 

BIN  F 
N  FIXE 
:16000 
IN  FIX 
BIN  FI 
IN  FIX 
BIN  FI 
TRY  EX 
ENTRY 
N  FIXE 
IN  FIX 

FIXED 
N  FIXE 


FD 
ED 
D, 
ED 
ED 
IX 
) 

I 
A  P. 
) 
) 

ED 
D 
D 

XE 
ED 
XE 
XE 
D 

FD 
ED 
D 

XT 
ED 
D 
D 

ED 
IX 
D 
) 

ED 
XE 
ED 
XE 
T, 
FX 
D 
ED 


EXT, 
EXT, 


EX 

EX 

ED 

INI 

NIT 

(9) 

INI 

INI 

EX 

EXT 

EXT 

D  E 

IN 

D  E 

D  S 

EXT 

EX 

EX 

EXT 


T, 
T, 

STAT 
TIAL 
IAL( 
INI 
TIAL 
TIAL 
T, 


IC 

('APPLY')  STATIC, 
•EVAL')  STATIC, 
TIAL( 'EVALQUOTE' ) 
CEVCON')  STATIC, 
(  'EVLIS')  STATIC, 


STATIC, 


XT, 

ITI AL(8) 

XT, 

TATIC, 

f, 

T, 


STATIC, 


EXT, 
INITIALC5)  STATIC, 
EXT, 

ED  EXT, 

INITIAK4)  STATIC, 

BIN  FIXEDOI)  EXT, 

EXT, 
D  EXT, 

EXT, 
D  EXT, 


T, 
EXT. 

STATIC, 
XT, 
INITIAL(9) 


STATIC, 
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NULL  ENTRY  EXT, 

ONE  BIN  FIXED  INITIAL(l)  STATIC, 

PERIOD  BIN  FIXED  EXT, 

PLUSS  BIN  FIXED  EXT, 

PNAME  BIN  FIXED  EXT. 

PRBUFF  CHARU28)  STATIC, 

PRNAME  RETURNS(CHAR(30)  VARYING), 

QUOTE  BIN  FIXED  EXT, 

RECUR  BIN  FIXED  STATIC, 

RPAR  BIN  FIXED  EXT, 

SEVEN  BIN  FIXED  INITIAL(7)  STATIC, 

SIX  BIN  FIXED  INITIALC6)  STATIC, 

SLASH  BIN  FIXED  EXT, 

STAR  BIN  FIXED  EXT, 

SUBR  BIN  FIXED  EXT, 

T    BIN    FIXEO    EXT, 

THREE    BIN    FIXED    INITIAH3)     STATIC, 

TRACE    BIN    FIXED    INITIALCO)     EXT, 

TRACE1    BIN    FIXED    INITI AL(O) EXT, 

TWO    BIN    FIXED    INITIAL(2)    STATIC, 

VAL1  BIN  FIXED; 

/*  EVALQUOTE  */ 

NBLKS=l;  ERFLAG,RECUR=0;  PRBUFF* ( 128 ) •  •; 

IF  NATOM(FNEVQ)=T  THEN   /*  CHECK  FOR  TOP  LEVEL  SP.  FORMS  */ 
DO;  IF  NGET(FNEVO,FEXPR)-.=  NIL  THEN 

DO;  VALl=NEVAL(NCONS(FNEVO,AEVO),NIL);  GOTO  EXEVO;  END; 

IF    NGET<FNEVQ,FSUBR)-=NIL    THEN 
DO;    VALl=NEVAL(NCONS(FNEVO,AEVO),NIL);    GOTO    EXEVO;    END; 
END; 

VAL1=NAPPLY(FNEVQ,AEVQ,NIL); 
EXEVO:    IF    ERFLAG>0    THEN    VAL1=NIL;    DISPLAYS     »); 
DISPLAYC 'VALUE    IS:»)  ; 
RETURN(VALl) ;  /*    RETURN   TO    LISP    SUPERVISOR   */ 

NAPPLY:    PROC(FN.ARGS,NALST)    RECURSIVE; 
/*    APPLY:    BINDS    VARIABLES    AND    FUNCTION    NAMES    ON    THE    A-LIST    AND 
HANDLES    FUNARG    DEVICE    (FUNCTIONAL    ARGUMENTS  I    */ 

OCL    ( ABIND,FN,ARGS,NALSTtCARFN,NEXPR,NSU8R,VAL2)FIXED    BIN, 
(TRCA,TRC1)    FIXED    BIN    INITIALCO), 
FNCTN   CHAROO)     VARYING; 
IF    NPROP<APPLY,FLAG,NIL)-=NIL    THEN 
DC ;    TRC A=l S 

CALL    Pf RACE (C APPLY, FN, ARGS,NALST, THREE, TWO); 
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END; 
IF    FN=NIL    THEN 

DC;    VAL2=NIL;    GO    TO    EXAP;     END; 
IF    NATO*MFN)=T    THFN 

/*    LOOK    FOR    BINDING    OF    FUNCTION    ON    PROP.    LIST    */ 

DO;     FNCTN=PRNAME( FN); 
/*SURR*/  NSUBR=NGET(FN,SU8R) ; 

IF    NSUBR-.=  NIL    THEN 

DO;     IF    NPROP(FN,FLAG,  NIL)-*=NIL    THEN    TRACE1  =  1 
VAL2=NPROC(NSUBR,APGS,F,FNCTN); 
GO    TO    EXAP;    END; 
/*EXPR*/  NEXPR=NGET(FN,EXPRI ; 

IF    NEXPR-=NIL    THFN 
DO;     IF    NPROP(FN,FLAGfNIL)-.=  NIL    THEN 

DO;    CALL    PTRAC£(FNCTN, ARGS, NIL , N IL ,ONt ,1 
TRC1=1;     END; 
VAL2=NAPPLY(NEXPR,ARGS,NALST); 
IF    TRC1=1    THEN 
DO;       CALL    PTRACE(FNCTN,VAL2»NIL,NIL, 

ONE, ONE);    TRC1=0;     END; 
GO    TO    EXAP; 
END; 

/*  LOOK  FOR  BINDING  OF  FUNCTION  ON  A-LIST  */ 

ABIND=NSASSOC(FN,NALST,TWO) ; 
IF  ABIND=TWO  THEN 
DO;   EPFLAG=2; 
DISPLAY( 'UNDEFINED  FUNCTION  -  APPLY'); 
GO  TO  EXAP; 
END; 

VAL2=NAPPLY(NCDR(ABIND),ARGS,NALST); 
GO  TO  EXAP; 
END; 

CARFN=NCAR(FN) ; 
/*    CHECK    FOR    SPECIAL    FORMS    */ 
/•LAMBDA*/    IF    NEO(CARFN , LAMBDA) =T    THEN 

/*    BIND    VARIABLES    AND    ARGUMENTS    ON    A-LIST    */ 

DO;    VAL2=NEVAL(NCADDR(FN),NCONC(NPAIR(NCADR(FN), ARGS)t 
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NALST));    GO    TO    EXAP;    END; 
/*    LABEL    */    IF    NEQ(CARFN,LABEL)=T    THEN 

/*    CONS    THE    FUNCTION    NAME    AND    DEFINITION,    ADD    TO    A-LIST, 
AND    CALL    APPLY      */ 

DO;    VAL2=NAPPLY(NCADDR(FN1, ARGS, NCONS ( NCONS ( NC ADR ( FN), 
NCADDR(FNI) ,NALST) )  ;  GO   TO    EXAP;    END; 

/*FUNARG*/       IF    NEQ(CARFN,FUNARG)=T    THEN 

DO ;    VAL2=NAPPLY  ( NCADR ( FN ) , ARGS , NCADDR ( FN  )  ) ; 
GO    TO    EXAP;    END; 
VA L2 =NAP PLY (NEVAL( FN, NALST), ARGS, NALST); 
EXAP:       IF    EPFLAG>0    THEN    VAL2=NIL; 
IF    TRCA=l    THEN    DO; 

CALL    PTRACE ( C APPLY, VAL2, NIL, NIL, ONE, ONE); 
TRCA=0; 
END; 
RETURN(VAL2) ; 
END    NAPPLY; 

/*    EVAL    */      NEVAL:    PROC ( FORM, ALST )    RECURSIVE; 
/*    EVALUATES    FORMS    */ 

DCL    (    TRCE    ,    NCEV,TRFEX)    FIXED    BIN; 

DCL    (FORM,    ALST,    ALBND.NAP. CFORM, ALBD, VAL 3, INDIC , TRFX) 
FIXED    BIN,    FNCTN    CHAR(30)    VARYING; 
/♦TRACE*/         IF    NPR0P(EVAL,FLAG,NIL)-.=NIL    THEN 

DC ;    TRCE=1 * 

CALL    PTR ACE (CEVAL, FORM, ALST, NIL, TWO, TWO); 
END; 
/*    NIL    */         IF    FORM=NIL    THEN    DO;    VAL3  =  NIL;    GO   TO    EXEV;     END; 
/♦NUMBER*/       IF    NUMBERP(FORMI=T    THEN    DO;    VAL3=F0RM;    GO    TO    EXEV;     END; 
/*    ATOM    ♦/       IF    NATOM(FORM)=T    THEN 

/♦    LOOK    FOR    VALUE    BINDING    ON    PROP.    LIST    ♦/ 

DO;       NAP=NGET(FORM,APVAL); 

IF    NAP-^  =  NIL    THEN    DO;    VAL3  =  NCAR  (NAP) ;    GO    TO    EXEV;    END; 

/*    LOOK    FOR    VALUE    BINDING    ON    A-LIST    */ 

ALB ND=NS ASSOC (FORM, ALST, THREE); 
IF    ALBND=THREE    THEN 
DO;      ERFLAG=3; 
DISPLAY( 'UNBOUND    VARIABLE   -    EVALM; 
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GO    TO    EXFV; 

END; 

VAL3=NCDR( ALEND) ; 
END; 
CFGRv=NC£R(FORM)  ; 


GO  TO  EXEV; 


/*  CHECK  FCR  SPECIAL  FORMS  */ 

/*QLOTE*/   IF  CFOPM=QUOTE  THEN 

DO;   VAL3=NCADR(F0RM) ;  GO  TO  EXEV;  END; 
/*FUNCTION*/IF  CFORV=FNCTION  THEN 

DO;  VAL3=LIST3(FUNARG,NCADR(FORM),ALST); 
GC  TO  EXEV;  END; 
/*  CGND  */  I*1  CFORM=CGND  THEN 

DO;   VAL3=NEVCON(NCDP(FORM) , ALST);  GO  TO  EXFV;  END 

/*  TEST  FOR  PROG  HERE  WHEN  IT  IS  IMPLEMENTED  */ 

IP  NATOM(CFORM) =T  THEN 
DO;  FNCTN=PRNAME(CFORMJ; 

/*  LOCK  FCR  FUNCTION  DEFINITION  ON  PROP.  LIST  */ 

/*SLmR*/  INDIC=NGET<CFORM,SURR)  ;  IF  INDIC-.=NIL  THEN 

DC;  IF  NPR0P(CF0RM,FLAG,NID-.=  NIL  THEN  TRACF1  =  T 
VAL3=NPROC(INDlC,NEVLIS<NCDR(FORM),ALST  ), 
F, FNCTN);  GO  TO  EXEV;  END; 
/*EXPR*/  INDIC  =  NGET(CFCRMf  EXPR)  ;  IF  INDIC-*  =  NIL  THEM 

DO;   NCEV=NEVLIS(NCDR( FORM), ALST); 

IF  NPROP(CFORM,FLAG,NIL)-.=  NIL  THEN 
DO  *   TRFX  =  1* 

CALL  PT RACEt FNCTN, NCEV , NIL, N IL, ON F, TWO 
END; 

VAL3  =  NAPPLY ( I NDI C , NCEV , ALST  )  ; 
IF  TREX=1  THEN 
CO*   T  R  E  X = 0  * 

CALL~PT RACE (FNCTN, VAL3, NIL, NIL, ONE, O^E) 
END; 

GO  TO  EXEV; 
END; 
/*FSLBR*/         INDIC=NGET(CFOPM,FSUBR) ;  IF  INDIC-=NIL  THEN 

DO;  IF  NPROP(CFORM,FLAG,NIL)-.=  NIL  THEN  TRACF1  =  T; 
VAL3=NPR OC < I NDIC,NCDR( FORM), ALST, FNCTN)  ; 
GO  TO  EXEV;  END; 
/*FEXPR*/         INDIC=NGET(CFORM,FEXPR) ;  IF  INDIC-=NIL  THEN 
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00;    IF    NPR0P(CF0RM,FLAG,NIL)-=NIL    THEN 
00;    TRFEX=1; 

CALL    PTR ACE (FNCTN,NCDR( FORM), NIL, NIL, ONE, TWO); 
END; 
VAL3=NAPPLYUNDIC,LIST2<NCDR(FORM),ALST), 

ALST) ; 
IF    TRFEX=1    THEN 
DO  *    TRE  X  =0* 

CALL    PTRACE(FNCTN,VAL3, NIL, NIL, ONE,  ONE ) ; 
END; 

GO    TO    EXEV; 
END; 

/*  LOOK  FOR  FUNCTION  DEFINITION  ON  A-LIST  */ 

ALBD=NS ASSOC (CFORM, ALST, ONE); 

IF  ALBD=ONE  THEN 

DC;   ERFLAG=l; 
DISPLAY! 'UNDEFINED  FUNCTION  -  EVAL»); 
GO  TO  EXEV; 

END; 

VAL3=NEVAL(NC0NS(NCDR(ALBD),NCDR(F0RM)  ), ALST)  ; 

GO  TO  EXEV; 
END; 

VAL3 =N APPL Y < NC AR < FORM ), NEVL IS <NCDR< FORM), ALST), ALST); 
EXEV:IF  ERFLAG>0  THEN  VAL3=NIL; 
IF  TRCE=1  THEN  DO; 

CALL  PTRACE(CEVAL,VAL3,NIL,NIL,0NE,0NE); 

TRCE=0; 

END; 
RETURN(VAL3) ; 
END  NEVAL; 

/*  EVLIS  */   NEVLIS:  PROCC MEV, AEV)  RECURSIVE; 
/*  EVALUATES  ITEMS  IN  A  LIST  */ 

DCL  (MEV,AEV,VAL4)  FIXED  BIN; 
IF  MEV=NIL  THEN  RETURN(NIL); 

RETURN(NCONS(NEVAL(NCAR(MEV),AEV),NEVLIS(NCDR(MEV),AEV)) ); 
END  NEVLIS; 

/*    EVCON    */       NEVCON:    PROC (CEVC, AEVC)    RECURSIVE; 
/*   EVALUATES    CONDITIONAL    FORMS    */ 

DCL    (CEVC, AEVC, VAL5)    FIXED    BIN; 
IF    CEVC=NIL    THEN 
DO;       EPFLAG=4; 
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DISPLAY* 'CONDITIONAL  UNSATISFIED  -  EVCON'); 

GO  TO  EXEVC: 
END; 

VAL5=NEVAL(NCAAR(CEVC) ,AEVC) : 
IF    VAL5-.  =  F    THEN 

IF    VAL5-.  =  NIL    THEN 

DO;       VAL5=NEVAL(NCADAR(CEVC),AEVC); 
GO    TO    EXEVC; 

END; 
VAL5=NEVCQN(NCDR(CEVC> ,AEVC) ; 
EXEVC:    IF    ERFLAOO    THEN    VAL5  =  NIL; 
RETURN(VAL5) ; 
END    NEVCON; 

PRNAME;    PROC(JPN)     CHAR(30)     VARYING; 

/*    RETURNS    CHARACTER    STRING    OF    PRINT    NAME    OF    FUNCTION     • JPI 
WHICH    IS    LIMITED    TO    30    CHARACTERS    */ 
DCL    ( JPN,PRN1,KPN,I)     FIXED    BIN, 
FNCTN    CHAROO)     VARYING, 
CH    CHAR(l) ; 
PRN1  =  NGET( JPN,PNAVE)  ; 
FNCTN=(30)»     •; 
1=1;     KPN=PRN1; 
DO    WHILE     (KPN-.=  NIL); 

UNSPEC(CH)=SUBSTR(UNSPEC(FSTOR(KPN) ), 9,8); 
SUBSTR(FNCTN,I,1)=CH; 
1=14-1;    KPN=NCDR  (KPN)  ; 
END; 

F NC TN= SUB STP( FNCTN, 1,1-1); 
RETURN(FNCTN) ; 
END    PRNAME; 

NPROC;    PR0C(IX,NARGS,FINDX, FNCTN)     RECURSIVE; 

/*    RETURNS    VALUE    OF    SYSTEM    SUBR    AND    FSUBR    FUNCTIONS. 

NUMBER    OF    SYSTEM    FUNCTIONS     IS    LIMITED    TO    255    WHICH 
IS    THE    MAX    NUMBER    REPRES ENTABLE     IN    8    BITS    */ 
DCL    (IX,NARGS,FINDX, I ND, KARGS , ARG( 3 ) , VAL6, J  X, J ) F I XED 
DCL    A(128>     LABEL     ; 

DCL    FNCTN    CHAR(30)    VARYING,    AR(3)    LABEL    ; 
IF    FINDX-=F    THEN  /*    FSUBR    */ 

DO;       IND  =  SUBSTR(UNSPEC(FSTOR( IX)  ),9,8); 
IF    TRACE1=T    THEN 

CALL    PT R AC E ( FNCTN, NARGS, NIL, NIL, ONE, TWO); 
GO    TO    A( IND) ; 
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/* 


SPRD 


END; 

SPREAD    ARGUMENTS    INTO    STANDARD    CELLS    ARG( 1 ) , ARG( 2) t ETC 

KARGS=NARGS; 

Jf JX=1; 

IF  KARGS=NIL  THEN  GO  TO  INDEX; 

ARG( J)=NCAR(KARGS) ; 

KARGS=NCDR(KARGS) ; 

J=J+1;    GC    TO    SPRD; 


*/ 


/*    MAX    NO.    ARGS    =    3*/ 


INDEX: 

AR(1) 
AR<2) 
AR(3) 


/*    GET    SUBR    NUMBER    FROM    CAR    OF    CELL     • IX»    */ 

IND=SUBSTR(UNSPEC(FSTOR< IX)) ,9,8); 

IF    TRACE1=T    THEN    DO;     JX=J-1;    GO   TO    AR(JX);     END; 

ELSE    GO    TO    A(IND); 

CALL    PTRACE(FNCTN,ARG(l)tNILfNIL,ONE»TWO); 

GO    TO    A(IND) ; 

CALL    PTRACE(FNCTN,ARG(l)t ARG( 2 ) r NIL,TWO, TWO ) ; 

GO    TO    A(IND) ; 

CALL    PTRACE(FNCTN,ARG(l),ARG(2)tARG(3),THREF,TWO) ; 

GO    TO    A(IND) ; 


/*  CONS  */  Ad)  : 

/*  CAR  */  A(3)  : 

/*  CDR  */  A(2)  : 

/*  EO  */  A(4) : 

/*  ATOM  */  A<5) : 

/*  CAAR  */  A(6) : 

/*  CADR  */  A<7)  : 

/*  CDAR  */  A(8) : 

/*  CDDR  */  A(9) : 

/*  CAAAR  */  AUO) 

/*  CAADR  */  A(ll) 

/*  CADAR  */  A(12) 

/*  CDAAR  */  A(13) 

/*  CADDR  */  A(1A) 

/*  CDADR  */  AC15) 

/*  CDDAR  */  A(16) 

/*  CDDDR  */  A(17) 

/*  RPLACA  */  A(18) 

/*  RPLACD  */  A(19) 

/*  NULL  */  A(20) 

/*  EQUAL  */  A(2l) 

/*  APPENO  */  A(22) 


VAL6=NCONS(ARG(l), 
VAL6=NCAR(ARG(1) ); 
VAL6=NCDR(ARG(1) ) ; 
VAL6=NE0(ARG(1), AR 
VAL6=NAT0M(ARG(1) ) 
VAL6=NCAAR(ARG(1) ) 
VAL6  =  NCADR(ARG(1)  ) 
VAL6=NCDAR(ARG(1) ) 
VAL6  =  NCDDR(ARG(1)  ) 
VAL6=NCAAAR(ARG(1) 
VAL6=NCAADR(ARG(1) 
VAL6=NCADAR(ARG(1) 
VAL6=NCDAAR(ARG(1) 
VAL6=NCADDR(ARG(1) 
VAL6=NCDADR(ARG(1) 
VAL6=NCDDAR(ARG(1) 
VAL6=NCDDDR(ARG(1) 
VAL6=NRPLACA(ARG(1 
VAL6=NRPLACD(ARG(1 
VAL6=NULL(ARG(1) ); 
VAL6=NE0UAL(ARG(1) 
VAL6=NAPPEND(ARG(1 


ARG(2) );  GO  TO  EXPROC 
GO  TO  EXPROC; 
GO  TO  EXPROC; 
G(2));  GO  TO  EXPROC; 
;  GO  TO  EXPROC; 
;  GO  TO  EXPROC; 
;  GO  TO  EXPROC; 
;  GO  TO  EXPROC; 
;  GO  TO  EXPROC; 
GO  TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
TO  EXPROC; 
12));  GO  TO 


GO 

GO 

GO 

GO 

GO 

GO 

GO 

♦  ARG 

tARG 

GO  T 

ARG( 

,ARG 


EXPROC; 
(2) );  GO  TO  EXPROC; 
0  EXPROC; 

2) );  GO  TO  EXPROC; 
(2) );  GO  TO  EXPROC; 
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/*  COPY  */ 
/*  MEMBER  */ 
/*  PAIRLIS  */ 


/*  ASSOC  */ 

/*  SUB2  */ 

/*  SURLIS  V 

/*  SASSOC  */ 


/*  NCONC  */ 
/*  ATTRIB  */ 
/*  SUBST  */ 


/*  PROP  */ 

/*  GET  */ 
/*  PAIR  */ 


A(23) 
A(24) 
A(25) 

A(?6) 
A(27) 
A  (  2  3 ) 
A<29) 

A(  30) 
A(31) 
A(32) 

A(33) 

A(34) 
A(35) 


DISPLAY*  «A 


/*  NUMBERP  */  A(36) 

/*  EFFACE  */  A(37) 

/*  LENGTH  */  A(38) 

/*  LAST  */  A(39) 

/*  DEFINE  */  A(A-O) 

/*  DtFLIST  */  A(41) 

/*  CSET  */  A(42) 

/*  REMPROP  */  A(43) 

/*  FLAG  */  A(44) 

/*  REMFLAG  */  A(45) 

/*  REVERSE  */  A(4M 

/*  NOT  */  A(47) 

/*  PRIN1  */  A(48) 

/*  TFRPRI  */  A(49) 

/*  PRINT  */  A(50) 

/*  REAO  */  A(51) 

/*  EVAL  */  A(52) 

/*  APPLY  */  A(53) 

/*  TRACE  */  A(54) 

/*  UNTRACE  */  A<55) 

/*  ADD1  */  A(56) 

/*  SUB1  */  A(57) 


VAL6  = 

VAL6  = 

VAL6  = 

GO 

VAL6  = 

V*L6  = 

VAL6  = 

VAL6  = 

GO 

:  VAL6= 

:  VAL6= 

:  VAL6= 

GO 

:  VAL6= 

G 

:  VAL6= 

:  VAL6= 

IF 

DO 

PGUMENT 

GO 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
VAL6  = 
GO 
VAL6 
VAL6 
VAL6 
VAL6 


NCOPY(A 
MEMBER( 
NPAIRLS 

TO  EXP 
NASSOC( 
NSUR2(A 
NSUBLIS 
NSASSOC 

TO  EXP 
NCONC (A 
NATTRI8 
NSUBST( 

TO  EXP 
NPROP(A 
0  TO  FX 
NGET( AR 
NPAIR(A 

VAL6=N 

;       ERFL 

S    NOT    L 

END; 

TO  EXP 
NUMBERP 
NEFFACE 
LENGTH( 
LASTtAR 
NDEFINE 
NDEFLST 
NCSET(A 
NREMPRP 
NFLAG(A 
NREMFLG 
NREVERS 
NOT ( ARG 
NPRINK 
NTERPRI 
NPRINT( 
NRFAD(A 
NEVAL(A 
NAPPLY( 

TO  EXP 
=NTPACE 
=NUNTRC 
=NADD1( 
=NSUB1( 


PG(l) 

ARG(1 

(ARG( 

ROC; 

ARGd 

RG  (  1 ) 

(APG( 

(ARG( 

ROC; 

RG  ( 1  ) 

(ARG( 

APG(1 

ROC; 

RG(1  > 

PROC; 

G(l)  , 
RGd) 
IL    TH 

AG  =  5; 
ISTS 


);  GO  TO 
),ARG(2) 
1) ,ARG(2 

)  ,APG<2) 
t APG(2)i 
1),ARG(2 
1),ARG(2 

,APG(2) ) 
1  )  tARG(2 
) ,ARG(2) 


exproc; 

);    Gn  to   fxproC; 
),APG(3) ); 


);  GO  ti  ex 
;  GO  TO  EXP 
) );  GO  TO  E 
),ARG( 3)); 

;  GO  TO  EXP 
));  GO  TO  E 
, ARG(3) ); 


, ARG(2)»ARG(3)); 

ARGd) );     GO    TO    FX"R 
,ARG(2) ); 

EN 


PROC; 

ROC; 

XPROC: 


ROC; 
XPROC 


OC; 


OF    EQUAL    LENGTH    -    PAIRM 


ROC; 

(ARGd 

(ARGd 

ARGd) 

G(l)  ); 

(ARG(1 

(ARGd 

RG(1), 

(ARG(I 

RG(l), 

(ARG (I 

(ARG( 1 

(1)  ); 

ARG(I) 

;    GO    T 

ARGd) 

RG(1) ) 

PG(l), 

ARGd) 

ROC; 

(ARGd 

E(ARG( 

ARGd) 

ARGd) 


) );  GO  TO 
) tARG(2)> 
);    GO   TO 

GO   TO    PX 
)  );    GO    TO 
>,ARG(2) ) 
ARG(2)); 
),ARG(2) ) 
ARG(2)); 
),ARG(2) ) 
)  );    GO   TO 
GO   TO    EXP 
);    GO    TO 
0    EXPROC; 
);    GO    TO 
;    GO   TO    E 
NIL);     GO 
, ARG(2),N 


FXPROC; 
;     GO    TO    EXPROC: 
EXPROC; 
PROC; 

EXPROC; 
;     GO    TO    EXPROC: 
GO    TO    EXPROC; 
;     GO    TO    EXPPOC: 
GO    TO    EXPROC; 
;    GO    TO    EXPROC: 

EXPROC; 
ROC; 
EXPROC; 

EXPROC; 

XPROC; 

TO    EXPROC; 

ID; 


) );    GO   TO   EXPROC; 
1) );    GO    TO    EXPROC; 
) ;    GO   TO   EXPROC; 
);    GO   TO   EXPROC; 
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/*    AND    */  A(58):  VAL6=NAND(NARGS , F INDX ) ;    GO   TO    EXPROC: 

/*    OR    */  A(59):  VAL6=N0R(NARGS,FINDX);     GO    TO    EXPROC; 

/*    CSETQ    */  A(60):  VAL6=NCSETQ(NAPGS , F INDX ) ;    GO    TO    EXPPOC; 

/*    LIST    */  A(61):  VAL6=LI ST (N ARGS , F INDX > ;     GO    TO    EXPROC: 

EXPROC:       IF    TRACE1=T    THEN    CALL    PTR ACE ( FNCTN, V AL6,NIL , NIL, ONE, ONE  I 
TRACE1=F: 
RETURNS VAL6) ; 

END    NPROC; 

/*    LISP    FUNCTIONS    WHICH    REQUIRE    ACCESS    TO    CURRENT    A-LIST    */ 

/*    LIST    */      LIST:    PROC (LSARG, ALS ) ; 

/*    RETURNS    A    LIST    OF    ITEMS    ON    LIST    LSARG    AFTER    THEY    APF 
EVALUATED    */ 

DCL    (LSARG, ALS)     FIXED    BIN; 

IF    NCAR(LSARG)=QUOTE    THEN    RETURN( NCADR (LSARG )) ; 
RETURN(NEVLIS( LSARG, ALS) ); 
END    LIST; 

LIST2:    PROCUARG2  ,LARG3)  ; 

/*    RETURNS    A    LIST    OF    THE    TWO    ARGUMENTS    */ 
DCL    (LARG2,LARG3) ; 

R£TURN(NCONS ( LARG2, NCONS (LARG3, NIL) )); 
END    LIST2; 

LIST3:    PROC    ( LARG4  ,LARG5 , LARG6 I ; 

/*    RETURNS    A    LIST    OF    THE    THREE    ARGUMENTS    */ 
DCL    (LARG4,LARG5,LARG6)| 

RETURN( NCONS ( LAP G4, NCONS (L ARG5 , NCONS ( L ARG6, N IL ) ) ) ) ; 
END    LIST3; 

/*    CSET    */      NCSET:    PROC ( SETOB, SETVAL ) ; 

/*    PUTS    APVAL    INDICATOR    ON    PROPERTY    LIST    OF    VALUE    OF    SETOR 
WHICH    POINTS    TO    VALUE    OF    SETVAL    */ 
OCL    (SETOB, SETVAL, CST)    FIXED    BIN; 
IF    NPROP(SETOB, APVAL, NIL)=NIL    THEN 

CST =NRPL ACD ( L AS T(NCDR( SETOB)), NCONS (APVAL, 
NCONS (NCONS (SETVAL, NIL), NIL))); 
ELSE    CST=NRPL AC A (NGET( SETOB, APVAL), SETVAL); 
RETURN( SETOB) ; 
END    NCSET; 
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/*  CSETQ  */   NCSETC:  PROC ( SETGOB, SETQAL ) : 

/*  WORKS  LIKE  NCSET  BUT  THE  FIRST  iRPUMENT  IS  QUOTED 
OCL  (SfcTQOB, SFTQVAL,SETQVAL1, SETQAL)  FIXED  BIN: 
SETQVALl=NcVAL(NCADR(SETOOB) , SETQAL); 
RE  TURN (NC SET < NCAR ( SETQOB > , S ETQVAL1 )  ); 
END  NCSPTQ; 


*/ 


/*    AND 


/* 


AND 


ONE    EVALUATf 
IF    THE    END    nf 


NAND:     PPCCUNOLST,AALS)  ; 
EVALUATEC    EACH    ITE"    IN    THE    LIST    ANDLST    UNTIL 

TO    F    OP     NIL.        RETURNS    F     IN    THIS    CASE    OR    T 

THE    LIST    IS    RcACHEC    */ 

DCL     ( ANDLST, ANDLST1 , AND1 , AALS )     FIXED    BIN; 

ANDLST] =ANDLST; 
:     IF    ANDLST1=NIL    THEN    RETURN(T); 

AND1=NEVAL(NCAR( ANDLST1) ,AALS) ; 

IF    AND1=F     |     AND1=NIL    THEN    RETURN(F): 

ANDLST1=NCDR( ANDLST1) ;    GO    TO    AND; 

END    NAND: 

/*  OR  */   NOR:  PROCfPRLST.OALS) ; 

/*  EVALUATES  EACH  ITEM  IN  THE  LIST  OPLST  UNTIL  ONE  CVALUATE< 

TO  SOMETHING  OTHER  THAN  T.   RETURNS  T  IN  THIS  CASE  OR  f 

IF  ALL  ITEMS  EVALUATE  TO  F  OR  NIL  */ 

DCL  (0RLST,03LST1 ,  EVALOR , OALS )  FIXED  BIN; 

GRLST1-OPLST; 
OR:   IP  nRLSTl=NIL  THEN  RETURN(F); 

EVALOR=NEVAL<NCAR(ORLSTl)fOALS); 

IF  EVALCP-=F  THEN 

IF  EVALOR-=NIL  THEN  RETURN(T); 

ORLSTl=NCDR(ORLSTl);  GO  TO  OR; 

END  NOR: 

/*  OLTPLT  FUNCTICNS  */ 

/*  PRINT  */  NPRINT:  ENTRY ( XPP I N) ; 

/*  PRINTS  THE  S-EXPRESSION  PASSED 
DCL  (XPRINtDPl)  FIXED  BIN; 
PRBUFF=( 128) •  •; 
BUFFCGN=NBLKS; 
DPl=NPOIN(XPRIN) ; 
DP1=NTERPRI ; 
RETURN(XPRIN) ; 

NPRIN:  PROC(KPRIN)  RECURSIVE; 

/*    PUTS    REPRESENTATION    CF    S-EXPRESSION    KPRIN 


AS    THE    ARGUMENT    */ 


IN    PRINT    BUFFE'' 


78 


DCL    (DUM1,DUM2,DUM3,JPRIN,KPRIN)    FIXED    BIN; 

IF    NATOM(KPRIN)=T    THEN    GO    TO    DP; 

JPRIN=KPRIN; 

SUBSTRfPRBUFF^UFFCON,!)^ (• ;     BUFFCON=BUFFCON+l; 
AP:       DUM2=NPRIN(NCAR( JPRIN) ); 

IF    NCDP( JPRIN)=NIL   THEN    GO   TO    CP; 

SUBSTR(PRBUFF,BUFFCON,l>=»     •;     BUFFCON=BUFFCON*l; 

IF    NATCM(NCDR(JPRIN) )=T    THEN    GO    TO    BP; 

JPRIN=NCDR(JPRIN) ; 

GO    TO    AP; 
BP:       SUBSTR(PRBUFF,BUFFCON,l)=*.» ;     BUFFCON=BUFFCON+l; 

SUBSTR(PRBUFF.BUFFCON,l»=«     •;     BUFFCON=BUFFCON* 1: 

DUM3=NPRIN1(NCDR(JPRIN)) ; 
CP:       SUBSTR(PRBUFF,BUFFCON,l)=« )• ;     BUFFCON=BUFFCON+l; 

RETURN(KPRIN) ; 
DP:       DUM3=NPRIN1(KPRIN) ; 

RETURN(KPRIN) ; 

END    NPRIN; 

/*  PRIN1  */  NPRINl:  PROC(NPRN); 

/*  PUTS  PRINT  NAME  OF  ATOM  »NPRN»  ON  PRINT  BUFFER  */ 
DECLARE 

TBUFF  CHARU4)  STATIC, 
TBUFF1  CHARU4)  VARYING, 
TPBUFF  CHAR(30)  STATIC, 
LENGTH  BUILTIN, 
CH  CHAR(l)  STATIC, 

(KPRN,NPRN,DPRN.PC,LC,LPR,LPR1)  FIXED  BIN  ; 
IF  NUMBERP(NPRN)=T  THEN    /*  IS  ATOM  A  NUMBER?  */ 
DO;   TBUFF=(14)»  •; 

TBUFF=FSTOR(NCDR(NPRN) ); 

PC  =  1  * 

DO  WHILE  (SUBSTP (TBUFF, PC, 1)=*  •);  PC=PC+1;  ENC 

TBUFF1 =SUBSTR (TBUFF, PC, 15-PC); 

LC=LENGTH(TBUFF1); 

SUBSTR( PR  BUFF, BUFFCON, LC )-T BUFFI; 

BUFFCON=BUFFCON+LC; 

RETURN(NPRN) ; 
END; 

LPR=1;  TPBUFF=(30)«  •; 

KPRN=NGET(NPRN,APVAL) ;  /*    CHARACTER    OBJECT?    */ 

IF    NCAR(KPRNI<128    THEN   GO   TO    NPRA; 
KPRN=NGET(NPRN,PNAME) ; 
NPRA:DO    WHILE    (  KPRN-.=  NI  L)  ; 

UNSPEC(CH)=SUBSTR(UNSPEC(FSTOR(KPRN) ),9,8); 


79 


/* 


TERPRI 
/* 


SUBSTR(TPBUFF,LPR,1)=CH; 

KPRN=NCDR(KPRN) ; 

LPR=LPR+1; 
END; 

LPRl=LPR-l; 

IF  (LPR1+BUFFC0N)>120  THEN  OPRN  =  NTEP PR  I ; 
SUBSTR(PPBUFF,BUFFC0N,LPR1)=SUBSTR<TPBUFF,1,LPR1 ) 
BUFFC0N=8UFFC0N+LPR1 ; 
RETURN(NPRN) ; 
END  NPPIN1; 

*/   NTERPRI:  PROC; 

PRINTS  CURRENT  CONTENTS  OF  PRINT  BUFFER  */ 

DISPLAY(PRBUFF) ; 

PRBUFF=(128) •  •; 

BUFFCON=NBLKS; 

RETURN(NIL) ; 

END  NTERPRI : 


FUNCTIONS  ARE 

ONLY  FOR  FUNCTIONS  Wl 


FIXED  BIN 


•  t 


PTRACfc:  PROC(FNAMEjARGl.ARG2,ARG3,NGS,IO) ; 

/*    DISPLAYS    TRACE    INFO    ON    TERMINAL    WHEN 
ENTERED    AND    EXITED    -    WILL    NOW    WORK 
LESS    THAN    FOUR    ARGUMENTS       */ 
DCL    ( ARGl,ARG2,ARG3tNGS,IOtLIMf LF) 
LENGTH    BUILTIN, 
FNAME    CHAROO)     VARYING; 
LF=LENGTH(FNAME) ; 
IF    I  0  =  1     THEN    GO    TO   LEAVE; 

IF    NBLKS>80    THEN    DO;     RECUR=RECUR U;     NBLKS=1;     END; 
SUBSTR(PRBUFFfNBLKS»12*LF)=«CALL    •  |  I  FNAMEI  I  •  «     A<?  GS 
LIM=NTERPRI ; 
LIM=NPPINT(ARG1) ; 
IF    NGS=1    THEN    GO    TO    EXPTR; 
LIM=NPPINT(ARG2) ; 
IF    NGS=2    THEN   GO    TO    EXPTR; 
LIM=NPPINT(ARG3) ; 
EXPTR:    NBLKS=NRLKS+4; 
RETURN; 
LEAVE:    NBLKS=NBLKS-4 ; 

IF  NBLKS<1  THEN  DO; 

IF  RECUR>0  THEN  DO; 

RFCUR=RECUR-1;  NBLKS=80;  END; 
ELSE  NBLKS=1; 
END; 
SUBSTR(PRBUFF,NBLKS,13+LF)=»VALUE  OF  • | I FNAMEI I •  IS:1 
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LIM=NTERPRI; 
LI^=NPPINT(ARG1) ; 
RETURN; 
END    PTRACE; 


END    NEVALO; 
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/*  LISPc:  INITIALIZATION  ROUTINE  */ 
INITIAL:  PPOC: 


DECLARE 
ACCUM  CHAR 
ALPBASE  BI 
APPLY  BIN 
APVAL  BIN 
BLANK  BIN 
BP  BIN  FI X 
BNUM  BIN  F 
BUFFER  CH* 
BUFPNO  BIN 
CADD  BIN  F 
CHARSET  CH 
COMMA  BIN 
CONO  BIN  F 
COUNT  BIN 
CTR  BIN  FI 
DASH  BIN  F 
DIGBASE  BI 
OCLLAR  BIN 
-FSTOR  BIN 
EXPR  BIN  F 
EQSIGN  BIN 
EVAL  BIN  F 
F  BIN  FIXE 
FEXPR  BIN 
FNCTION  BI 
FREE  BIN  F 
FSUBR  BIN 
FLAG  BIN  F 
FST0R(0:16 
FUNARG  BIN 
J J  BIN  FIX 
JK  BIN  FIX 
LABEL  BIN 
LAMBDA  BIN 
LCOUNT  BIN 
LINE  BIN  F 
LPAR  BIN  F 
MFSTOR  BIN 
MODETAG  BI 
NBASE  BIN 


(30) 

N  FI 
FIXE 
FIXE 
FIXE 
ED  E 
IXEC 
R(72 

FIX 
IXED 
AP  (E 
CIXE 
IXED 
FIXE 
XBD 
IXED 
N  FI 

FIX 

FIX 
IXED 

FIX 
IXED 
D  FX 
FIXE 
N  FI 
IXED 
FIXE 
IXED 
000) 

FIX 
ED  F 
ED, 
FIXE 

FIX 

FIX 
IXED 
IXED 

FIX 
T(l) 
FIXE 


EX 
XED 
0  E 
0  E 
D  E 
XT, 

EX 
)  E 
ED 

EX 
3) 
D  E 

EX 
D  E 
EXT 

EX 
XED 
ED 
ED 

EX 
ED 

EX 
T, 
D  E 
XED 

EX 
D  E 

EX 

BI 
ED 
XT, 


T, 

EXT, 
XT, 
XT, 
XT, 

T, 

XT, 

EXT, 

T, 

EXT, 

XT, 

T, 

XT, 


EXT 


EXT, 

EXT, 

EXT, 

T, 

EXT, 

T, 

XT, 
EXT, 

h, 

T, 

N  F 1X50(31) 

EXT, 


EXT, 


D  EXT, 
ED  EXT, 
ED  EXT, 

EXT, 

EXT, 
ED  EXT, 

EXT, 
D  EXT, 
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NIL  BIN  FIXED  EXT, 
NREAO  ENTRY  EXT, 
PERIOD  BIN  FIXED  EXT, 
PLUSS  BIN  FIXED  EXT, 
PNAME  BIN  FIXED  EXT, 
QUOTE  BIN  FIXED  EXT, 
RETAG  BIT(l)  EXT, 
RE1TAG  BIT(l)  EXT, 
RPAR  BIN  FIXED  EXT, 
SLASH  BIN  FIXED  EXT, 
STAC(200)  BIN  FIXED  EXT, 
STAR  BIN  FIXED  EXT, 
STKTAB  BIT(1)  EXT, 
SUBR  BIN  FIXED  EXT, 
T  BIN  FIXED  EXT, 
TCOUNT  BIN  FIXED  EXT, 
VAR  CHAR(IO)  VARYING, 
VAR1  CHAR(l), 
VAR2  BIN  FIXED  EXT; 

DISPLAY!*  M; 

DISPLAY* «NPS  LISP  1.5  MOD  1  INITIALIZING'); 
DISPLAYS  »);  RETAG, RE1TAG=«0«B; 

MFSTOR=16000;  NBASE=MFSTOR-300;  EFSTOR-NBASE-1; 
DO  1*1  TO  127;  FSTOR(I>=0;  END;   /*  ZERO  OUT  OBLIST  */ 
DO  1=128  TO  MFSTOR-1;  FSTOR ( I 1-1*1 ;  ENO;   /*  LINK  UP  */ 
FREE=128;  FST0R(MFSTOR)=O;  FSTOR< EFSTOR )=0; 
BNU*=MFSTCR; 

DO  1=1  TO  200;  STAC(I)=0;  END; 
APPLY=1030;  EVAL=1018; 
CHARSET=»  .$£*( )-+=»": ;?,/ABCDEFGHIJKLMN0PQRSTUVWXYZ0123456789, ; 
ALPBASE  =  INDEX(CHARSET,«AM-l; 
DIGBASE=INDEX(CHARSET,«0» )-l; 
LINE,LCGUNT=1; 
MODETAG,STKTAB=«0«B; 
TCOUNT, BUFFNO=0; 
NIL=142;  PNAME=135;  APVAL=154;   /*  BOOTSTRAP  VALUES  */ 

buffer=«pname  nil  apval  expr  subr  fexpr  fsubr  cond  quote  £•; 

jk=nread; 

buffer=»slash  pluss  dash  star  blank  eqsign  comma  period  £•; 

JK=NREAD; 

BUFFER=»DCLLAR  RPAR  LPAR  £•; 

JK=NREAD; 

BUFFER=»FUNCTION    FUNARG    LAMBDA    LABEL    F   T    FLAG    £■; 

JK=NREAD;    LINE=i; 
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INIT1 


A12 


BUFFER='CONS    CDR    CAR    EO    ATOM    CAAR    CADR    CDAR    CDDR    CAAAR 
JK=NREAD; 

BUFFER='CADAR    CDAAR    CADDR    CDADR    CDDAR    CDDDR    RPLACA    RP 
JK=NREAO; 

RUFFER=«NULL    EQUAL    APPEND    COPY    MEMBER    PAIRLIS    ASSOC    S 
JK=NREAD; 

buffer=»sublis  sassoc  nconc  attrib  subst  prop  get  pat 

jk=nread; 

buffer=«numberp  efface  length  last  oefine  deflist  csf 

JK=NREAD; 

BUFFER=«REVPRCP    FLAG    REMFLAG    REVERSE    NOT    F,  •  ; 

JK=NREAD; 

BUFFER='PRIM    TERPRI    PRINT    READ    FVAL    APPLY    £•; 

JK=NREAD; 

BUFFER=*TPACE  UNTRACE  ADD1  SUB1  £•; 

JK=NREAD; 

BUFFER='AND    CR    CSETQ    LIST    €•;     JK=NREAD; 

STKTAB=«1 •*: 

RETURN; 

ENTRY(Il) ; 
DECLARE 

SWT( 10:20)     LABEL(A1,A2,A3,A4,A5, A6 , A7, A8 , A9, A10, Al 1 ) 
INITIAL(Al,A2,A3»A4,A5,A6,A7f A8,A9, A10,A11); 


CAADR; 
LACD    G 
UP?    F.« 
R    E«  ; 

T   F,  •  : 


GOTO    SWT(  U) 


Al:    VAR1=«/'  :    GOTO  A12; 

A3:    VARl=«-«;    GOTO  A12; 

A5:    VAR1=«    •;    GOTO  A12; 

A7:    VAR1=»  ,  •  ;    GOTO  A12; 

A9:    VARl=«t«;    GOTO  A12;       A10:    VAR1=»)*; 

All:    VAR1  =  M  '  ; 

L=UNSPEC(VAR1  )  ;    VAR2=NC0NS ( L , NIL ) : 


A2:  VAR1=«*« 

A4:  VAR1=«*' 

A6:  VAR1=,=« 

A8:  VAR1='.' 


GOTO  A12: 
GOTO  A12; 
GOTO  A12; 
GOTO  A12; 
GOTO  A12: 


JJ=-1;  RETURN: 


INITL:  ENTRYD2)  : 
/*  SETS  UP  APVALS  AND  PROGRAM  VARIABLE  VALUES  */ 
DECLARE  LB(27)  LABEL; 
GOTO  LBU2)  ; 

LB(1):   PNAME=CADD;  RETURN; 
LB(2):   NIL=CADD;  VAR2=NC0NS ( NI L,NIL ) ;  CALL  SETAP(NIL 

RETURN; 
LB(3):   APVAL=CADD;  RETURN; 
LB(4):   EXPR=CADD:  RETURN; 
LB(5):   SUBR=CADD;  RETURN; 
LB(6):   FEXPR=CADD;  RETURN; 


); 
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LBC7) : 
L8(8)  : 
LB(9) : 
LB(10) 
LB(ll) 
LB(12) 
LB(13> 
LBU4) 
LB( 151 
LB( 16) 
LB(17) 
LB( 18) 
LBU9) 
LB(20) 
LB(21) 
LB(22) 
LB<23) 
LB(24) 
LB(25) 

LB(26)  : 
LB(27)  : 

RETURN; 


fsubr=cadd;  return; 
c0nd=cadd;  return; 
oucte=cado;  return; 

slash=cadd;  call  setap ( slash) ;  return; 
pluss=cadd;  call  setap(pluss);  return; 
dash=cadd;  call  setap(dash);  return; 
star=caoo;  call  setap(star);  return; 
blank=caod;  call  setap( blank ) ;  return; 
eosign=cadd;  call  set ap( eosign) ;  return; 
comma=cadd;  call  set ap( comma) ;  return; 
perioo=cado;  call  set ap ( period) ;  return; 
dollar=cadd;  call  setap(dollar);  return; 
rpar=cado;  call  setap(rpar);  return; 
lpar=cadd;  call  setap(lpar);  return; 
fnctign=cado;  return; 
funarg=cadd;  return; 
lambda=caod;  return; 
label=cadd;  return; 

f=cadd;  m=nrplacd(ncddr(f), ncons (apval, 
ncgns(ncons(nil,nil),nil)l);  return; 
t=caod;  var2=ncons(t,nil);  call  setap(t); 
flag=cado;  return; 


RETURN; 


SETAP:  ENTRY(SAPVL) ; 

DCL  SAPVL  BIN  FIXED; 

M=NRPLACD(NCDDR(SAPVL) tNCONS( APVAL, NCONS ( VAR2t NIL ) ) ); 

RETURN; 

INITL2:  ENTRY(I3) ; 
/*  SET  UP  SUBR  INDICATORS  */ 
LM=NCDDR(CADD) ; 

M=NRPLACD(LM, NCONS (SUBR, NCONS ( NCONS ( 13, NIL )  ♦  N IL ) ) ) ; 
RETURN; 

INITL3:  ENTRYU4)  ; 
/*  SET  UP  FSUBR  INDICATORS  */ 
LM=NCDDR(CADD) ; 

M=NRPLACD(LM, NCONS ( FSUBR, NCONS ( NCONS (14, NIL),  NIL) )); 
RETURN; 

END  INITIAL; 
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LISPF:  PROC; 

/*  LISPF:  READER,  DUMP,  LOAD,  ANO  GARBAGE  COLLECTER  */ 

READER;  ENTRY(VAR,INPT)  BIT(l); 

DECLARE 

ASCTR  BIN  FIXED  EXT, 

ASNMBR  BIN  FIXED  EXT, 

ASTAG  BIT(l)  EXT, 

BNUM  BIN  FIXED  EXT, 

CARDNOl  BIN  FIXED(31,0)  EXT, 

CARDN02  BIN  FIXED(31,OI  STATIC, 

CB32  BIT(32)  , 

DB32  BIT(32)  STATIC, 

DTAG  BIT(l)  EXT, 

EFSTOR  BIN  FIXED  EXT, 

ESTART  BIN  FIXED(31)  EXT, 

FREE  BIN  FIXEO  EXT, 

1  FCB  EXT, 

2  COMMAND  CHAR(8) • 

2  FILENAME  CHAR(8), 

2  FILETYPE  CHAR(8), 

2  CARD  NUMBER  BIN  FIXED(31,0), 

2  STATTJS  BIN  FIXED(31,0), 

2  CARD  BUFFER  CHAR(80). 
FST0R(0U60fl0)  BIN  FIXED(31)  EXT, 
FCTR  BIN  FIXED  STATIC, 
INPT  CHARC72) , 
LC  BIN  FIXED  STATIC, 
LCOUNT  BIN  FIXED  EXT, 
NBASE  BIN  FIXED  EXT, 
PI  BIN  FIXED  STATIC, 
P2  BIN  FIXED  STATIC, 
PPTR  BIN  FIXED  STATIC, 
PTR  BIN  FIXED(31)  STATIC, 
RTAG  BIT<1>  EXT, 
STOR  ENTRY  RETURNS ( BI T ( 1) ) , 
TCQUNT  BIN  FIXED  EXT, 
TEMPBUFF  CHAR(80) • 
TEST  ENTRY  RETURNS ( BIT ( 1) I , 
TTAG  BIT(l)  STATIC, 
VAR  CHAR(25)  VARYING, 
VAR2  CHAR(2), 
VAR4  CHAR(4)J 
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TTAG='0'B; 

IF    TC0UNT=2    THEN    GOTO    Rl; 

INPT=»     '; 

IF    ASTAG    THEN    IF    ASCTR=ASNMBR    THEN 

DO;    OISPLAY(VAR)     REPLY(INPT);    CALL    DUSAVE;    CALL    TSAVE: 

GOTO    R2; 

END; 
Rl:    DISPLAY(VAR)    REPLY(INPT); 
R2:    IF    INPT=«END    LISP*    THEN    RETURN( «0 • B ) ; 
ELSE    RETURN(  *1«B); 

DUSAVE:    ENTRY; 

IF    -DTAG    THEN   DO;    FI LENAME= • AUTOLISP' ;    COMMANDS  FRASE1 
CALL    IHEFILE(FCB); 
END; 
ELSE    FILENAME=,DUMPLISP»;    F ILETYPE=« DATA* ; 
CARD    BUFFER*11;    ASCTR=0;    LC=1; 

COMMlND=«WRBUF»;     PTR,PPTR=5;    CARDN02=1;    Pl*l; 
IF:    IF    FSTOR(LC+l)=FSTOR(LC)+l    C 

FST0R(LC+2)=FST0R(LC«-1)  +  1    THEN 

DO;    UNSPEC< VAR2)=SUBSTR(UNSP£C(PPTR),17,  16) ; 
CARD    NUMBER=DIVIDE<Pl,80,31,0)+l; 
IF    CffRO    NUMBER-=CARDN02-1    THEN 

OOT    TEMPBUFF=CARD    BUFFER;    TTAG=*1»B;    END; 
CALL    CLOSE;    CALL    OPEN; 
COMMAND=*RDBUF« ;    CALL    IHEFILE( FCB) ; 
CALL    CLOSE; 
I=CARD    NUMBER*80; 
P1=80-TI-P1);    COMMAND='WRBUF«; 

SUBSTRCCARD    BUFFER, PI, 2)=VAR2;     P1=PPTR;     FCTR=0; 
CALL    IHEFILt(FCB) ; 

IF    TTAG    THEN    CARD    BUFFER=TEMPBUFF; 
P2=LC;    TTAG=«0»B;~ 

DO    WHILE(FSTOR<LC+l)=FSTOR(LC)+l    t    LC<15999); 
LC=LC-H;    FCTR=FCTR*1; 
END; 
LC=LC+l;    UNS PEC (VAR2l=SUBSTR(UNSPEC(FCTR)f 17,16); 
SUBSTR(CARD_BUFFER,PTR+2,2)=VAR2;    PTR=PTR-*4; 
PPTR=PPTR+4;    IF    -TEST   THEN   GOTO    R3; 
UNSPEC ( VAR4 ) =UNSPEC ( FSTOR < P2 ) ) ; 
SUBSTR(CARD    BUFFER, PTR,4)=VAR4;    PTR=PTR+4; 
PPTR=PPTR+4;    IF    -.TEST    THEN   GOTO    R3; 
ENO: 
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4; 


IF    LO16000    THEN    IF    -STOR   THEN    GOTO    R3; 

UNSPEC(VAR4)=UNSPEC(FST0R(LO); 

SUBSTR(CARD    BUFFER  ,PTR»4)=VAR4 ;     PTR=PTR+4;    PPTR=PPTR+4; 

LC=LC+1;  IF"--TEST  THEN  GOTO  R3;  GOTO  IF: 
R3:  COMMAND=»FINUFD'  ;  CALL  IHEF ILE< FCB) ;  1  =  1;  RTAG=«l»B: 

CALL    TEXTWRK(I);    UNSPEC( VAR4)=UNSPEC ( EST ART ) ; 

SUBS TR < C ARD    BUFFER ,10,4) =VAR4;    RTAG='0«B; 

UNSPEC(VAR4T=UNSPEC(FREE);    SUBSTR(CARD    BUFFER, 20, 4 ) = V«* 
UNSPEC(VAR4)=UNSPEC(EFST0R);    SUBSTR(CARD"    BUFFER,  1  4,  4)  =VAF 

UNSPEC(VAR4)=UNSPEC(BNUM) ;    SUBSTRCCARD   BUFFER , 30, 4) = VAR' 

UNSPEC( VAR4) =UNSPEC( LCOUNT ) ;     SUBSTRtCAfcD    BUFFER, 2, 4 ) =VAF 
UNSPEC(VAR4)=UNSPEC(CARDN01) ;    SUBSTRtCARD    BUFFER,  6,  4  )=VAF 

COMMAND=»WRBUF» ;    CALL    IHEFILEC FCB) ;    COMM*ND= • FINUFD* ; 

CALL    IHEFILE(FCB) ;    RETURN; 

STOR:    ENTRY    BIT(l)  ; 

CARD  NUMBER=CARDN02;  CALL  IHEFILEi FCB) ;  PTR=1; 
CARDft02=CARDNC2+l ; 

CARD  BUFFER*11;  IF  LO16000  THEN  RETURNS  «0 »  B) ; 
ELSE  RETURNC  «1'B) ; 

TEST:  ENTRY  BIT(l); 

IF  PTR=81  THEN 

IF  -.STOR  THEN  RETURN  ( «0  •  B)  ; 

ELSE  RETURN( U  »B) ; 
RETURNt  U'B)  ; 

LOADER:  ENTRY; 

COMMAND=»RDBUF« ;  CARD  NUMBER=1;  CALL  IHEF ILE( FCB ) ; 
IF  STATUS  =  1  THEN  DO;  D"I  SPLAY  I  •  FILE  NOT  FOUND1):  RETURN;  END: 
VAR2  =  SUBSTR(CARD  BUFFER,1,2);  DB32= ( 32  )  • 0' B; 
SUBSTR<DB32,17,l5)=UNSPEC(VAR2) ;  PPTR=DB32; 
P1,PTR=5;  P2=l; 
Ll:  DO  WHILE(PTP<PPTR)  ; 

VAR4=SUBSTR(CARD  BUFFER , PI  ,4) ;  DB32=UNSPEC ( VAR4) ; 

FST0R(P2)=DB32; 

P2=P2*1;    Pl=Pl+4;    PTR=PTR*4;    IF    P2=16001    THEN    RETURN; 

IF    Pl=81    THEN   DO;    Pl  =  l  ;    CALL    RDR;    END; 

END; 

VAR2= SUBSTR< CARD  BUFFER ,Plt 2);  DB32= ( 32) • 0* B; 

SUBSTR < 0832,17 ,15) =UNS PEC (VAR2);  PPTR=DB32; 

Pl=Pl+2;  VAR2=SUBSTR(CARD_8UFFER,P1,2); 
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DB32=<32) »0«B;  SUBSTR < DB32 , 17 ,16) =UNSPEC< VAR2  ) ; 

FCTR=DB32;  LC=1;  Pl=Pl+2:  PTR=PTR+4; 

IF  Pl=81  THEN  DO;  Pl=l;  CALL  RDR;  END; 

VAR4=SUBSTR(CARD  BUFFER, PI ,4) ; 

UNSPEC(FST0R<P2JT=UNSPEC<VAR4);  PTR=PTR+4;  Pl=Pl+4;  P2=P2+1 

IF  Pl=81  THEN  DO;  Pl  =  l ;  CALL  RDR;  END; 

DO  WHILE(LC<=FCTR) ; 

FST0R(P2)=FST0R(P2-1)+1;  P2=P2+1; 

IF  P2=16001  THEN  RETURN;  LC=LC+1; 

END; 

GOTO  LI; 

RDR:  ENTRY; 

CARD  NUMBER=CARD_NUMBER-M;  CALL  IHEFILE(  FCB) ; 
RETURN; 

COLLECT:  ENTRY; 

/*  THIS  IS  THE  GARBAGE  COLLECTER  */ 

DECLARE 

APVAL  BIN  FIXED  EXT, 

CTR  BIN  FIXED  EXT, 

EXPR  BIN  FIXED  EXT, 

FEXPR  BIN  FIXED  EXT, 

FSU8R  BIN  FIXED  EXT, 

II  BIN  FIXED  STATIC, 

II  BIN  FIXED  STATIC, 

JJ  BIN  FIXED  STATIC, 

JOIN  ENTRY(BIN  FIXED) , 

L4  BIN  FIXED  STATIC, 

LL  BIN  FIXED  STATIC, 

MARK  ENTRY(BIN  FIXED) , 

MEXPR  ENTRYCBIN  FIXED)  RETURNSCBIN  FIXED), 

MFSTOR  BIN  FIXED  EXT, 

NUNSTK  ENTRY  EXT, 

NIL    BIN   FIXED    EXT, 

PNAME    BIN   FIXED    EXT, 

PNME    ENTRYCBIN   FIXED)    RETURNS(BIN    FIXED)* 

SUBR  BIN  FIXED  EXT; 

DB32=« OOOOOOOOOOOOOOOO 10O0000O000000O0»B; 
11=1:   /*  II:  OBLIST  NUMBER  */ 
CI:  IF  NCAR(II)=0  THEN 
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IF  11=127  THEN  GOTO  C2 ; 

ELSE  DO;  11=11+1;  GOTO  CI;  END; 
IF  11=128  THEN  GOTO  C2; 
LA,I1  =  NCDR(II  )  ; 
DO  WHILE*  I1-.  =  NIL)  ; 

JJ  =  NCAP(IU;   /*  JJ;  ATOM  HEADER  CELL  */ 

LL=JJ;  JJ=NCDR(JJ);  CALL  MARK(LL);  LL=JJ; 

IF    NCAR< JJ)=PNAME    THEN    JJ=PNMEUJ>;    ELSE 

DO;    JJ=NCDR(JJ);    CALL    MARK(LL);    LL=JJ;    JJ=PNME(JJ);     ENO: 

CALL  VARK(LL) ;  LL=JJ; 
C3:  JJ=NCDR(JJ);  CALL  MARK(LL);  IF  JJ=NIL  THEN  GOTO  INC;  LL-v 

IF  NCAR( JJ)=APVAL  I  NCAR ( J J ) =SUBR  | 
NCAR( JJ)=FSUBR  THEN 
DO;  JJ=PNME(JJ);  CALL  MARK(LL);  LL=JJ;  GOTO  C3;  END; 

IF  NCAP( JJ)=EXPR  |  NCAR( JJ)=FEXPR  THEN  J J=MEXPR ( J  J  )  ; 

CALL  MARK(LL);  LL=JJ;  GOTO  C3; 
INC;  I1=NCDR(U);  CALL  MARML4I;  L4=U; 
END; 

11=11+1;  GOTO  Cl; 
C2;  IF  ESTART  =  0  THEN  GOTO  C4;  LLt 1 1  =  EST ART; 
DO  WHILE(  II-.*NIL)  ; 

II=NCDP(II);  CALL  MARK(LL);  LL=II; 
END; 
CA*.  LL»  1 1  =F  REE; 

DO    WHILE(FSTOR(II )-=0) ; 
II=FSTOR(II) ;    CALL    MARK(LL);    LL=II; 

eno; 

CALL  MARK(LL) ; 
DO  WHILE(BNUM<=MFSTOR) ; 
FSTOR(BNUM)=BNUM+l ;  BNUM=BNUM+1; 
END; 

BNUM=BNUM-l;  II=EFSTOR; 
DO  1=128  TC  NBASE-1; 

CB32=UNSPEC(FSTOR(I))  £  OB32;  IF  CB32= ( 32 ) • 0» B  THEN 
CALL  JCIN(I) ; 
ELSE  DO;  CB32=UNSPEC (FSTOR ( I ) )  £ 

•11111 11 111111  111  01  llllllllllllll'B;  FSTOR  (I  )  =  CB32; 
END; 
END; 

EFSTOR=II;  FSTORUI)=0; 
RETURN; 

MEXPR;  ENTRY(Ml)  BIN  FIXED; 

DCL  F  BIN  FIXED  EXT; 
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M1=NCDR(M1I;  M2=NCAR(Ml); 
MEl:  M=NSTACK(M2)  ;  M2=NCAR(M2); 
DO  WHILE(NATOM(M2)=F) ; 

M=NSTACK(M2) ;  M2=NCAR(M2); 
END; 
ME2:  LfM2=NUNSTK;  M2=NCOR(M2>;  CALL  MARML);  L=M2; 
ME3:  IF  M2=NIL  THEN 

IF  CTR=200  THEN  RETURN(Ml); 

ELSE  DO;  LtM2=NUNSTK;  M2=NCDR(M2>;  CALL  MARK(L);  L  =  M2; 
GOTO  ME3; 
END; 
GOTO  MEl; 

MARK:  ENTRYC J5)  ; 

CB32=UNSPEC(FSTOR<J5)>  I  DB32 ;  FSTOR(  J5MCB32; 
RETURN; 

PNME:  ENTRYU6)  BIN  FIXED; 

J6=NC0R(J6);  L2,J7=NCAR(J6J;  J7=NCDR(J7);  CALL  MARKCL2);  L2=J7; 

DO  WHILE< J7-=NIL) ; 

J7=NCDR(J7);  CALL  MARK(L2);  L2=J7; 

END; 

RETURNS J6); 

JOIN:  ENTRY( J8) ; 

FSTOR(II)=J8;  IF  II=EFSTOR  THEN  CALL  MARK(II);  II=J8; 
RETURN; 


END  LISPF: 
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E3 


E3A 


E2C:  J=J+i; 

END; 

1  =  14-1  ;  IF  MCD(I,20)=0  THEN 

DO;  DISPLAY* •— CONTINUE?' )  REPLY(VARA); 

IF  SUBSTR(VARA,l,l)='Y'  THEN  GOTO  E2A;  ELSE 

END; 
GOTO  E2A; 
END; 

DO; 

DECLARE 

BP1  BIN  FIXED  STATIC, 

COMPARE  ENTRY  RETURNS < BIT ( 1 )) , 

CHEK  ENTRY  RETURNS* BIT ( 1 ) ) , 

CTR3  BIN  FIXED  STATIC, 

LE5  BIN  FIXED  STATIC, 

LEN  BIN  FIXED  STATIC, 

LEN1  BIN  FIXED  STATIC, 

PTR1  BIN  FIXED  STATIC, 

PTR2  BIN  FIXED  STATIC, 

SCNA  ENTRY  RE  TURNS < BI T ( 1) )  , 

VARD  CHAJU35)  VARYING; 


GOTO  EA 


VARA=«  •  ; 
IF  TCOUNT 
PTR2=  BP«- 
BP1=BP;  B 
CALL  TEXT 
LE5=LE5+1 
IF  -COMPA 
IF  L 

ELSE 

PTR2=BP*1 

IF  LEN1>L 

DO;  IF 

I=PT 

SUBS 

SUBS 

END; 

ELSE  IF  L 

DO;  1  = 

SUBS 

SUBS 

SUBS 


CALL  SCAN;  FILENAME= 
=0  I  SUBSTR(ACCUM,1, 
1;  IF  -SCNA  THEN  GOT 
P=PTP2;  RTAG='1'B;  L 
HRMLE5)  ; 

RE  THEN 

«=5>IE1  THEN  DO;  DISP 
GOTO  EA; 

GOTO  E3A; 

;  IF  -.SCNA  THEN  GOTO 
EN  THEN    /*  NEW  FIE 

-.CHEK  THEN  DISPLAY* 
Rl+LENl;  J=80-I+l;  K 
TR(CARD  BUFFER, I, J)= 
TR(CARDlBUFFER,PTRl, 

EN1-=LEN  THEN  /*  N 
PTR1+LEN1;  K  =  PTRH-LE 
TR(CARD  BUFFER, I,J)= 
TR(CARD"BUFFER,PTR1, 
TR(CARD_BUFFER,L+1,L 


•LISPTEXT';  CALL  CLOSE; 
l)-.=  »/«  THEN  GOTO  ER3; 
0  EA;  LEN=CTR3; 
E5=LE1; 


LAY( «*E6A: 
END; 


FIELD  NOT  FOUND*'  ) 


EA;    LEN1=CTR3; 
LD    LONGER    THEN    OLD    */ 
»**E6B:    TRUNCATED**'); 
=  PTRl-«-LFN; 

SUBSTR(CARD    BUFFER, K, J): 
LEN1  )=SUBSTE<  BUFFER,  BP+1,  LEND; 

EW    FIELD    SHORTER    */ 
N;    J=80-K*l;    L=80-LEN+LEN1 ; 
SUBSTR(CARD    BUFFER, K, J): 
LEN1)=SUBSTK(  BUFFER,  BP  «-l,  LEND  J 
EN-LENU  =  »     •; 
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E2:  00; 

DECLARE 

APVAL  BIN  FIXED  EXT, 

CH  CHAR<1) , 

CHR  CHAR(5)  VARYING, 

EXPR  BIN  FIXED  EXT, 

FEXPR  BIN  FIXED  EXT, 

FSUBR  BIN  FIXED  EXT, 

KK    BIN    FIXEDOl)  , 

PL(3)  LABEL, 

PNAME  BIN  FIXED  EXT, 

SUBR  BIN  FIXED  EXT; 

CALL  SCAN;  IF  TC0UNT=0  THEN 

DO;  DISPLAY( »**E5A:  »'TYPE«»  PARAMETER  MISSING**1!; 
GOTO  EA; 
END; 
IF  SUBSTR(ACCUM,1,1)=«A«  THEN  DO;  KJ=1;  GOTO  E2B;  END; 
IF  SUBSTR(ACCUM,1,1)='F»  THEN  DO;  KJ=2;  GOTO  E2B;  END; 
IF  SUBSTR(ACCUM,1,1)=»S«  THEN  DO;  KJ=3;  GOTO  E2B;  END; 
DISPLAY(»**£5B:  ••TYPE1'  PARAMETER  NOT  RECOGNIZED**1);  GOTO  EA; 
E2B  t  1=1* 
E2A:  IF  1=128  THEN  GOTO  EA;  JA=NCAR(I); 

IF  JA=0  THEN  DO;  1=1*1;  GOTO  E2A;  END; 

KK=I;  J=l  ; 

DO  WHILEC J<=JA) ; 

KK=NCDR(KK);  L=NCAR(KK);  GOTO  PL(KJ) 


PL(1):  IF  NGET<L,SUBR)-=NIL    NGET  (  L,  EXPR)-.=N  IL  I 
NGET(L,FSUBR)-.=NIL  I  NGET (L , FEXPR )-=NIL 
THEN  GOTO  E2C;  IF  NGET (L , APVAL )=NIL  THEN  CHR=» 


ELSE  CHR=» APVAL1;  GOTO  E2D; 
PL(2):  IF  NGET(L,SUBR)=NIL  t    NGET ( L, EXPR )=NIL  THEN  GOTO  E2C; 
IF  NGET(L,SUBR)=NIL  THEN  CHR=«EXPR»; 
ELSE  CHR=»SUBR«;  GOTO  E2D; 
PL<3):  IF  NGET<L,FSUBR)=NIL  €  NGET ( L, FEXPR )=NIL  THEN  GOTO  E2C 
IF  NGET(L,FSUBR)=NIL  THEN  CHR=«FEXPR»; 
ELSE  CHR=«FSUBR»; 
E2D:  L=NGET(L, PNAME) ;  M=l ;  ACCUM=«  •; 
DO  WHILE(L-=NIL); 

UNSPEC(CH)=SUBSTR(UNSPEC(FST0R(L)),9,8); 
SUBSTR(ACCUM,M,1)=CH;    M=M*1;    L=NCDR(L); 
END; 
DISPLAY(ACCUM| ICHR); 
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IF  SUBSTR(ACCUM,1,3)=,RET»  THEN  RETURN; 
IF  SUBSTR(ACCUM,1 ,1)='R»  THEN  GOTO  E5; 
IF  SUBSTR(ACCUMfl .COUNT )=• LIST •  THEN  GOTO  E2; 
IF  SUBSTR(ACCUM,1 ,1)='D'  THEN  GOTO  E4; 

OISPLAY( »**E1 :  EDIT  CALL  NOT  VALID.  TRY  AGAIN**');  GOTO  EA 
El:  DO;  IF  £START=0  THEN 

DO;  DISPLAY( «**E2:  NO  S-EXPRESSION  ENTERED**');  GOTO  EA;  E 
CALL  SCAN;  IF  TCOUNT=0  THEN  GOTO  EA;  IE=SUBSTR < ACCUM, 1, COUNT 
JE=1;  IF  RETAG  THEN  GOTO  EiC; 
CALL  SCAN; 
IF  TCOUNT-=0  THEN 

IF  SUBSTR(ACCUM,lfCOUNT)-.=  ',«  THEN  GOTO  ER1; 
ELSE  DO;  CALL  SCAN;  IF  TCOUNT=0  THEN  GOTO  ER1; 
JE=SUBSTR(ACCUM,1, COUNT); 
END; 
EIC:  FILENAME='LISPTEXT«  ;  CALL  CLOSE; 
E1B:  LN=ESTART;  JE=I E*( JE-1 ) ; 
DO  WHILE( IE<=JE) ; 

DO  WHILE(NCAR<LN)-=IE) ; 

IF  LN=NIL  THEN  GOTO  ER2 ;  LN=NCDDR ( LN) ; 
END; 
LE=NCADR( LN) ;   /*  LE=LINE  NUMBER  IN  LISPTEXT  */ 
RTAG='1'B;  CALL  TEXTWRK(LE);  IElfLEl=LE; 
IF  RETAG  THEN 

DO;  BUFFER=SUBSTR(CARD  BUFFER t 9, 72 ) ;  RE1TAG=»1'B; 
BP=72;  INTAG='1'B; 

LE1  =  NREAD;  IE1=NREAD;  LN=NEVALQ(LE1, I  El) ;  LN=NPR INT(LN) 
RE1TAG='0'B;  TCOUNT=2;  GOTO  E5A; 
END; 
DISPLAY(CARD  BUFFER);  LE=LE*1; 
IF  LE=CARDNOT  THEN  GOTO  E1A;  IE1=IE1+1; 
CALL  GBUFF; 

DO  WHILE(SUBSTR(CARD.BUFFER,lt 1)=»  •  £  STATUS=0); 
DISPLAY(CARD  BUFFER) ; 

IF  LE  =  CARDNOT  THEN  GOTO  E1A;  IE1ME1  +  1; 
CALL  GBUFF; 
END; 
IE=IE+1;  LN=ESTART; 
END; 
E1A:  RTAG='0'B;  GOTO  EA; 

ER2:  DISPLAY( »**E3:  S-EXPRESSION  NUMBER  NOT  FOUND**');  GOTO  EA: 
ER1:  DO;  DISPLAY( »**E3A:  FORMAT  ERROR;  PRINTING  S-EXP  NUMBER' I (IE 

GOTO  E1B;  END; 
ER3:  DISPLAY( «**E4:  ILLEGAL  EDIT  COMMAND**' );  GOTO  EA; 
END; 
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LISPG:  PROC; 

/*  THIS  IS  THF  LISP  EDITOR  */ 

EDITOR:  ENTRY; 

DECLARE 

ACCUM  CHAROO)  EXT, 

BP  BIN  FIXED  EXT, 

BUFFER  CHAR(72)  EXT. 

CARDNOl  BIN  FIXEDOl, 0)  EXT, 

COUNT  BIN  FIXED  EXT, 

FNDTAG  BIT(l)  EXT, 

ERSTAG  BIT(l)  EXT, 

ESTART  BIN  FIXEDOl)  EXT, 

FST0R(0:l6000)  BIN  FIXEDOl)  EXT, 

1  FCB  EXT, 

2  COMMAND  CHAR<8)  . 

2  FILENAME  CHAR!8), 

2  FILETYPE  CHAR!8) , 

2  CARD  NUMBER  BIN  FIXEDOl, 0), 

2  STATUS  BIN  FIXEDOl, 0), 

2  CARD  BUFFER  CHAR(80), 
IE  BIN  FIXED  STATIC, 
IE1  BIN  FIXED  STATIC, 
INTAG  BIT(l)  EXT, 
JE  BIN  FIXED  STATIC, 
LE  BIN  FIXED  STATIC, 
LEI  BIN  FIXED  STATIC, 
LN  BIN  FIXED  STATIC, 
NIL  BIN  FIXED  EXT, 
NREAD  ENTRY  EXT, 

READER  ENTRY(CHAR(25)  VARYING, CHAR! 72) )  RETURNS! BIT! 1 ) ) 
RETAG  BIT(l)  EXT, 
RE1TAG  BIT(l)  EXT, 
RTAG  BIT(l)  EXT, 
TCQUNT  BIN  FIXED  EXT, 
VARA  CHAP(25)  VARYING; 

DISPLAY!1  •);  DISPLAY! 'EDIT  LISP*); 
EA:  VARA=»  •;  IF  -.READER!  VARA,  BUFFER )  THEN 
DO;  ENDTAG=»1«B;  RETURN;  END; 
TC0UNT=2;  BP=0;  CALL  SCAN; 
IF  SUBSTR!ACCUM,1,1)='C«  THEN  GOTO  E3; 
IF  SUBSTR(ACCUM,l ,1)=»P»  THEN  GOTO  El; 
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END; 

ELSE    SUBSTR ( CARD    BUFFER , PTR1 ,L EN )=SUBSTR( BUFFER ,RP+1,L! 
DISPLAY(CARD    BUFFERT;    LE5=LE5-1;    RTAG='0'B;    COMMAND=«  WRBU! 
CARD.NUMRER=rE5;    CALL     IHEF I LE < FCB) ; 
GOTO    EA; 
END; 

SCNA:    ENTRY    BIT(l) ; 

CTR3=0  * 

DO    WHILE(  SUBSTR  (  BUFFER fPTR2  ♦  !)-.=  •/•  ); 

PTR2=PTR2+l;    CTR3=CTR3+1;     IF    CTR3=36    THEN 

DO;    DISPLAY< «**FIELD    TOO    LONG**');     RETURN <• 0« B ) ;     END: 
END; 
RETURN(  »1«B)  ; 

COMPARE:    ENTRY    BIT(l)  ; 

PTR1=2;    VARD=SUBSTR(BUFFERtBPl+l,LEN); 

DO    WHILE(VARD^=SUBSTR(  CARD    BUFFER  t  PTR  1,LEN  )    E    PTR1«-LEN<81 

PTR1=PTR1+1; 

END; 

IF    VARD=SUBSTR(CARD_BUFFER»PTR1,LEN)    THEN    RETURN (• 1 • B ) ; 

ELSE    RETURN( 'O^B) ; 

CHEK:    ENTRY    BITU) ; 

1=80*     J  =  0  * 

00    WHILi(SUBSTR(CARD_BUFFERtI tl)=«     •     £    JOLEN1-LENI  ; 

1=1-1;   J=J+l; 

END; 

IF  J>=LEN1-LEN  THEN  RETURN (• 1 « B) ; 

ELSE  RETURN( »0»B) ; 

£4:  DO; 

DECLARE 

CADD  BIN  FIXED  EXT, 

LOOKUP  ENTRY(BIN  FIXED)  RETURNS(BIN  FlXED)t 

POSIT  BIN  FIXED(31)  EXT; 

E4A:    CALL    SCAN;    IF    TCOUNT=0    THEN   GOTO    EA; 
CALL    HASH;    IF    LOOKUP  <  POSITKO    THEN 

DO;    DISPLAY! »**E7:    ATCM    NOT    FOUND***);    GOTO    EA;    ENDS 
I=POSIT;    LEN=NCAR(POSIT);    LEN1=NCDR ( POS IT ) ; 
DO    WHILE(NCAR(LEN1)-.=CADD)  ; 
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I=LEN1;    LEN1=NCDR(LEN1) ; 

END; 

IF    LEN=1    THEN    00;    FSTOR (POSIT ) =0 ;    GOTO    E4A;    END; 

LEN1=NRPLACD(I,NCDR(LEN1) ) ;    LEN=LEN-1; 

LEN1=NRPLACA(P0SIT,LEN) ; 

GOTO   E4A; 

END; 

E5:    DO; 

RETAG=,1»B;    GOTO   El; 
E5A:    RETAG='0»B;    GOTO    EA; 
END; 

GBUFF:    ENTRY; 

CALL    TEXTViRK(LE) ;    LE=LE+1; 
RETURN; 
END    LISPG; 
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LISPP:  PROC; 

/*  LISP  PRIMITIVE  (ELEMENTARY)  FUNCTIONS  */ 

DECLARE 

BFREE  BIN  FIXED  EXT, 

BNUM  BIN  FIXED  EXT, 

F  BIN  FIXED  EXT, 

FREE  BIN  FIXED  EXT, 

FST0R(0:16000>  BIN  FIXED(31)  EXT, 

GB16  BIT(16)  STATIC, 

GB32  BIT(32)  STATIC, 

GT1  BIN  FIXED  EXT, 

MFSTOR  BIN  FIXED  EXT, 

NC  BIN  FIXED  EXT, 

NIL  BIN  FIXEO  EXT, 

T  BIN  FIXED  EXT, 

TRACE  BIN  FIXED  EXT, 

TRCONS  BIN  FIXED  EXT; 

NCONS:  ENTRY(CNA,CNR) ; 

DCL  (CNA,CNB)  FIXED  BIN; 

GB32=UNSPEC(CNB) ; 

GB32=GB32  j  SUBSTR ( UNSPEC(CNA) , 17 , 16  ) ; 

GT1=NCELL; 

FSTQR(GT1)=GB32; 

RETURN(GTl) ; 

NCELL:  ENTRY; 

/*  GETS  THE  NEXT  AVAILABLE  CELL  IN  FREE  STORAGE  */ 
NC=FREE;  FREE=FSTOR(FREE); 
RETURN*  NC); 

NCAR:  ENTRY(CA); 

DCL  (CA)  FIXED  BIN; 

GB16=SUBSTR(UNSPEC(FST0R(CA) 1,1,161; 
GT1=GB16; 
RETURN(GTl) ; 

NCDR:  ENTRYtCD); 

DCL    (CD)    FIXED    BIN; 

GB16=SUBSTR(UNSPEC(FSTOR(CD) )  ,17,16); 
GT1=GB16; 
RETURN(GTl)  ; 


98 


NEO:    ENTRV( JEQ,KEQ)  ; 

DCL    (JEOtKEQ)    FIXED    BIN; 
IF    NATOMJFQ)=T    THEN 

IF    NATOM(KEQ)=T    THEN 

IF    JEQ=KEQ    THEN    RETURN(T); 
IF    NCDR( JEQ) >BNUM    THEN 

IF    NCDR(KEQ)>BNIJM    THEN 

IF    FSTOR(NCDR(JEQ))=FSTOR(NCDR(KEQ) ) 
THEN    RETURN(T); 
RETURN(F)  ; 

NATOM:  ENTRY( JAT)  ; 
DCL  JAT; 

IF  JAT>MFSTOR  THEN  RETURN(F); 
IF  JAT=NIL  THEN  RETURN(T); 
IF  FSTOR(JAT)<0  THEN  RETURN(T); 
RETURN(F)  ; 

NRPLACA:  ENTRY( JCA, KCA)  ; 

/*   REPLACES  CAR(JCA)  WITH  KCA   -   VALUE  IS  JCA   */ 
DCL  (JCA, KCA)  ; 

GB32=* OOOOOOOOOOOOOOOOllllllll 11 111 1U*B; 
GB32  =  GB32  S  UNSPEC (FSTOR ( JCA  I  )  ; 
GB32=GB32  I  SUBSTR (UNSPEC( KCA ) , 17 , 16  ) ; 
FSTOR(JCA)=GB32; 
RETURN( JCA)  ; 

NRPLACD:  ENTRY( JCD,KCD)  ; 

/*   REPLACES  CDR(JCD)  WITH  KCD   -   VALUE  IS  JCD   */ 
DCL  (JCD, KCD)  ; 

IF  JCD=NIL  THEN  RETURN(NIL); 

GB32=SUBSTP(UNSPEC(FST0R(JCD)),1,16)  I  UNSPEC(KCD); 
FSTOR( JCD)=GB32; 
RETURN( JCD)  ; 

END  LISPP; 
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APPENDIX  D 

USING  THE  NPS  LISP  1.5  VERS  1  SYSTEM,  AN  EXAMPLE 

EXECUTION  BEGINS 

--FILES  LISPTEXT  AND  DUMPLISP  EXIST-- 

NPS  LISP  1.5  VERS  1  INITIALIZING 

SPECIAL  OPTIONS? 
_n 

CALL  EVALQUOTE,  ARCS: 

Load$  lisptext  dumplisp 
LOADING  LISPTEXT 
LOADING  DUMPLISP 
CALL  EVALQUOTE,  ARGS: 
_revs  (a  b) 

VALUE  IS: 
(B  .  A) 

CALL  EVALQUOTE,  ARGS: 

_count$ 

CELLS  IN  FREE  STORAGE:  14509 

CELLS  AVAILABLE  FOR  NUMBERS:         300 

CALL  EVALQUOTE,   ARGS: 

_dump$ 

CALL  EVALQUOTE,  ARGS: 

_co!1ect$ 

CALL  EVALQUOTE,  ARGS: 

_count$ 

CELLS  IN  FREE  STORAGE:  14531 

CELLS  AVAILABLE  FOR  NUMBERS:         300 
CALL  EVALQUOTE,  ARGS: 

EDIT  LISP 

_P  1,3 

1  CONS  (A  B) 

2  DEFINE  (( 

(REVS  (LAMBDA  (X  Y)  (CONS  Y  X)))  )) 

3  REVS  (A  B) 

_c  /a  b/(a  b)  c/ 
3    REVS  ((A  B)  C) 

r  3 


100 


VALUE  IS: 
(C  A  B) 

_ret 

CALL  EVALQUOTE,  ARGS: 

dump$ 
CALL  EVALQUOTE,  ARGS: 
_end  lisp 
EXIT  LISP  SYSTEM 
R:  T=20. 62/32.68  19.47  01 
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GLOSSARY 


ATOM: 


A  synonym  for  atomic  symbol,  the  basic  constituent  of  an 
S-expression. 


BYTE: 

A  unit  of  the  IBM/360  memory  structure.   The  byte  consists  of  8 
binary  digits  (bits)  and  is  one-quarter  of  an  IBM/360  word. 

CODE-BYTE  (C-BYTE) : 

The  first  byte  of  the  first  line  of  file  LISPTEXT.   The 
C-byte  is  used  to  store  certain  codes  used  by  the  Supervisor 
to  handle  the  system's  special  files.   (See  Section  II.B.3.(b)) 


CRASH 


A  term  which  refers  to  the  abrupt  halt  in  service  due  to  a 
malfunction  in  a  time-sharing  system. 


DOUBLET: 


A  pair  of  S-expressions,  arguments  for  the  Interpreter  function 
EVALQUOTE. 


DUMP: 


The  action  of  copying  LISP  memory,  including  the  making  of 
copies  of  specific  values  and  files  needed  to  restore  the  LISP 
system  to  the  state  existing  at  the  time  of  the  dump. 


KEYWORD: 


A  special  word  used  in  the  files  AUTOLISP  and  DUMPLISP  to  link 
and  describe  areas  of  condensed  storage.   The  first  2  bytes  of 
the  keyword  contain  the  address  of  the  next  keyword.   The  last 
2  bytes  contain  the  number  of  words  of  FSTOR  which  were  condensed 
(i.e.,  the  number  of  adjacent  words  in  the  current  section  of 
FSTOR  which  contain  sequential  numbers).   A  keyword  (other  than 
the  first)  is  always  followed  by  a  word  containing  the  address 
of  the  first  word  of  the  condensed  section.   (See  Section  II. B. 3. 
(a)). 


OVERLORD : 


The  Supervisor  of  the  7090  LISP  system. 
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S-expression: 

Short  for  SYMBOLIC  EXPRESSION.   All  data  and  all  programs 
written  in  LISP  1.5  are  in  the  form  of  S-expressions  which 
are  made  up  of  either  an  ATOM,  'A',  a  dotted  pair  of  atoms 
(A.B),  or  a  dotted  pair  of  S-expressions,  ((A.B).C). 

S-EXPRESSION  DOUBLET: 

See  doublet. 
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